home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / misc / emu / Apex-src.lha / INTA.68K < prev    next >
Text File  |  2001-09-30  |  70KB  |  2,523 lines
  1. ;INTA.68K    AUG-05-90
  2. ;XPL intrinsics for the 68000
  3. ;Written by Loren Blaney
  4. ;This is derived from 6502 code written by P.J.R. Boyle.
  5. ;
  6. ;REVISION HISTORY:
  7. ;DEC-84, Original, known as: INT.68K.
  8. ;DEC-85, Added floating point intrinsics.
  9. ;FEB-86, Modified for 32-bit operations for DFM engineering.
  10. ;MAR-86, Modified for double-precision floating point.
  11. ;SEP-86, Converted to ASM68K conventions and modified.
  12. ;OCT-86, Modified to run in supervisor mode and to interface cleanly
  13. ;    with assembly language.
  14. ;NOV-86, Modified for second terminal (device 1)
  15. ;DEC-86, Added OPENF intrinsic and removed FASAVE
  16. ;FEB-87, Fixed test for file too long.
  17. ;MAR-87, Added graphics routines for the Amiga.
  18. ;     Added 32-bit multiply and divide.
  19. ;     Added intrinsics: SWAP_W, PEEK, POKE, EXT_L, and CARRY.
  20. ;APR-87, Changed string convention, BLIT(FROM, TO, SIZE), remainder.
  21. ;MAY-87, Cleaned up graphics intrinsics.
  22. ;JUL-87, Speed up CLEAR and VIEW, fix infinite loop in LINE clipping.
  23. ;AUG-87, Speed up LINE slightly.
  24. ;NOV-87, Fix line clipping.
  25. ;JUN-88, Modified for increased screen height (240/480), fixed CLEAR
  26. ;     intrinsic.
  27. ;JUL-07-88, Fix point plot on screens larger than 640x400.
  28. ;AUG-09-89, Fix glitch in VIEW & CLEAR intrinsics (removed CLR.Ws).
  29. ;AUG-05-90, Fixed CLEAR to work for all bit map dimensions, and added
  30. ;    BUTTON and JOYSTICK.
  31. ;
  32. ;NOTES:
  33. ;These intrinsics, unlike subroutines in general, may destroy the
  34. ; contents of registers D0 and A6. If, in the interest of speed,
  35. ; registers are not saved and restored, this should be clearly stated
  36. ; as part of the operation of the subroutine.
  37. ;
  38.     NOLIST
  39.     INCLUDE    SYSPAG        ;Get system page definitions
  40.     LIST
  41.  
  42. ;-----------------------------------------------------------------------
  43. ;INTRINSIC JUMP TABLE
  44.  
  45.     ORG    INTTBL        ;Compiler expects the jump table here
  46.  
  47.     JMP    ABS.L        ;0
  48.     JMP    RAN.L        ;1
  49.     JMP    REM.L        ;2
  50.     JMP    RESERV.L    ;3
  51.     JMP    SWAP.L        ;4
  52.     JMP    EXTEND.L    ;5
  53.     JMP    RESTAR.L    ;6
  54.     JMP    CHIN.L        ;7
  55.     JMP    CHOUT.L        ;8
  56.     JMP    CRLF.L        ;9
  57.     JMP    INTIN.L        ;10
  58.     JMP    INTOUT.L    ;11
  59.     JMP    TEXT.L        ;12
  60.     JMP    OPENI.L        ;13
  61.     JMP    OPENO.L        ;14
  62.     JMP    CLOSE.L        ;15
  63.     JMP    ABORT.L        ;16
  64.     JMP    TRAP.L        ;17
  65.     JMP    FREE.L        ;18
  66.     JMP    RERUN.L        ;19
  67.     JMP    GETHP.L        ;20
  68.     JMP    SETHP.L        ;21
  69.     JMP    GETERR.L    ;22
  70.     JMP    CURSOR.L    ;23
  71.     JMP    SCAN.L        ;24
  72.     JMP    SETRUN.L    ;25
  73.     JMP    HEXIN.L        ;26
  74.     JMP    HEXOUT.L    ;27
  75.     JMP    CHAIN.L        ;28
  76.     JMP    OPENF.L        ;29
  77.     JMP    WRITE.L        ;30
  78.     JMP    READ.L        ;31
  79.     JMP    BADINT.L    ;TESTPT.L    ;32
  80.     JMP    FGET.L        ;33
  81.     JMP    BADINT.L    ;FASAVE.L    ;34
  82.     JMP    FSAVE.L        ;35
  83.     JMP    BLIT.L        ;36 BLIT(FROM, TO, BYTES)
  84.     JMP    BUTTON.L    ;37
  85.     JMP    JOYSTICK.L    ;38
  86.     JMP    BADINT.L    ;SOUND.L    ;39
  87.     JMP    CLEAR.L        ;40
  88.     JMP    POINT.L        ;41
  89.     JMP    LINE.L        ;42
  90.     JMP    MOVE.L        ;43
  91.     JMP    BADINT.L    ;44
  92.     JMP    BADINT.L    ;BLOCK.L    ;45
  93.     JMP    RLRES.L        ;46
  94.     JMP    RLIN.L        ;47
  95.     JMP    RLOUT.L        ;48
  96.     JMP    FLOAT.L        ;49
  97.     JMP    FIX.L        ;50
  98.     JMP    RLABS.L        ;51
  99.     JMP    FORMAT.L    ;52
  100.     JMP    SQRT.L        ;53
  101.     JMP    LN.L        ;54
  102.     JMP    EXP.L        ;55
  103.     JMP    SIN.L        ;56
  104.     JMP    ATAN2.L        ;57
  105.     JMP    MOD.L        ;58
  106.     JMP    LOG.L        ;59
  107.     JMP    COS.L        ;60
  108.     JMP    TAN.L        ;61
  109.     JMP    ASIN.L        ;62
  110.     JMP    ACOS.L        ;63
  111.     JMP    BACKUP.L    ;64
  112.     JMP    BADINT.L    ;HICHAR.L    ;65
  113.     JMP    BADINT.L    ;PEEK.L        ;66
  114.     JMP    BADINT.L    ;POKE.L        ;67
  115.     JMP    BADINT.L    ;68
  116.     JMP    BADINT.L    ;69
  117.     JMP    BADINT.L    ;70
  118.     JMP    BADINT.L    ;71
  119.     JMP    BADINT.L    ;72
  120.     JMP    BADINT.L    ;73
  121.     JMP    BADINT.L    ;74
  122.     JMP    BADINT.L    ;75
  123.     JMP    BADINT.L    ;76
  124.     JMP    BADINT.L    ;77
  125.     JMP    BADINT.L    ;78
  126.     JMP    BADINT.L    ;79
  127.     JMP    BADINT.L    ;80
  128.     JMP    BADINT.L    ;81
  129.     JMP    BADINT.L    ;82
  130.     JMP    BADINT.L    ;83
  131.     JMP    BADINT.L    ;84
  132.     JMP    BADINT.L    ;85
  133.     JMP    BADINT.L    ;86
  134.     JMP    BADINT.L    ;87
  135.     JMP    BADINT.L    ;88
  136.     JMP    BADINT.L    ;89
  137.     JMP    BADINT.L    ;90
  138.     JMP    BADINT.L    ;91
  139.     JMP    BADINT.L    ;92
  140.     JMP    BADINT.L    ;93
  141.     JMP    BADINT.L    ;94
  142.     JMP    BADINT.L    ;95
  143.     JMP    BADINT.L    ;96
  144.     JMP    BADINT.L    ;97
  145.     JMP    BADINT.L    ;98
  146.     JMP    BADINT.L    ;99
  147.     JMP    BADINT.L    ;100
  148.     JMP    BADINT.L    ;101
  149.     JMP    BADINT.L    ;102
  150.     JMP    BADINT.L    ;103
  151.     JMP    BADINT.L    ;104
  152.     JMP    BADINT.L    ;105
  153.     JMP    BADINT.L    ;106
  154.     JMP    WAITVB.L    ;107
  155.     JMP    BITMAP.L    ;108 BITMAP(ADDR, WIDTH, HEIGHT, DEPTH)
  156.     JMP    BITMAP2.L    ;109 BITMAP2(MAGX, Y, OFFX, Y, INVX, Y)
  157.     JMP    VIEW.L        ;110 VIEW(ADDR, BPLCON0)
  158.     JMP    PALETTE.L    ;111 PALETTE(N, VAL)
  159.     JMP    CARRY.L        ;112
  160.     JMP    PEEK_W.L    ;113
  161.     JMP    POKE_W.L    ;114
  162.     JMP    PEEK_L.L    ;115
  163.     JMP    POKE_L.L    ;116
  164.     JMP    SWAP_W.L    ;117
  165.     JMP    EXT_L.L        ;118
  166.     JMP    CURSOR1.L    ;119
  167.     JMP    BUTES1.L    ;120
  168.     JMP    SHOCUR1.L    ;121
  169.     JMP    DEVINFO.L    ;122
  170.     JMP    UNTINFO.L    ;123
  171.     JMP    BUTES.L        ;124
  172.     JMP    GETKEY.L    ;125
  173.     JMP    KEYHIT.L    ;126
  174.     JMP    SHOCUR.L    ;127
  175.  
  176. REMAIN    DS.L    1        ;Remainder of most recent divide
  177.  
  178. ;32-bit multiply routines:
  179.     JMP    MUL1.L        ;D1:= D1 * D2
  180.     JMP    MUL2.L        ;D2:= D2 * D3
  181.     JMP    MUL3.L        ;D3:= D3 * D4
  182.     JMP    MUL4.L        ;D4:= D4 * D5
  183.     JMP    MUL5.L        ;D5:= D5 * D6
  184.     JMP    MUL6.L        ;D6:= D6 * D7
  185.  
  186. ;32-bit divide routines:
  187.     JMP    DIV1.L        ;D1:= D1 / D2
  188.     JMP    DIV2.L        ;D2:= D2 / D3
  189.     JMP    DIV3.L        ;D3:= D3 / D4
  190.     JMP    DIV4.L        ;D4:= D4 / D5
  191.     JMP    DIV5.L        ;D5:= D5 / D6
  192.     JMP    DIV6.L        ;D6:= D6 / D7
  193.  
  194. ;-----------------------------------------------------------------------
  195. ;All INT.68K variables are stored here. The 68020 compiler must know the
  196. ; location of REMAIN. The rest are grouped here for convenience when
  197. ; they are saved and restored by the multitasking exec.
  198. ;
  199. RANK    DC.L    2537        ;Random number seeds (initialized at
  200. RANL    DC.L    5149        ; load time)
  201. RANM    DC.L    7026        ;Random number that is actually output
  202.  
  203. BACKFL    DS.B    1        ;Backup flag, used to re-read last char
  204. LASTCH    DS.B    1        ;The last character read by BYTEIN
  205.  
  206. RASTER    DC.L    $60000        ;Location of current bit map
  207.  
  208. WIDTH    DC.L    640        ;Dimensions of RASTER in pixels
  209. HEIGHT    DC.L    240
  210. DEPTH    DC.L    1
  211.  
  212. MAGX    DC.L    0        ;Parameters affecting how coordinates
  213. MAGY    DC.L    0        ; are remapped from specified to
  214. OFFSETX    DC.L    0        ; actual hardware values
  215. OFFSETY    DC.L    0
  216. INVERTX    DC.L    0
  217. INVERTY    DC.L    0
  218.  
  219. X0    DC.L    0        ;Graphics coordinates (these might have
  220. Y0    DC.L    0        ; been remapped by the above parameters)
  221. X1    DC.L    0
  222. Y1    DC.L    0
  223.  
  224. COLOR    DC.L    0        ;Only lowest byte specifies color reg.
  225. MODES    EQU    COLOR+2        ;Bit 0: complement
  226.                 ;Bit 1: fast (i.e. don't clear zeros)
  227. TEXTURE    EQU    COLOR        ;For dotted lines, etc. Ones indicate
  228.                 ; where points are NOT plotted. 16 bits.
  229.  
  230.     IF    @ # $B96
  231.     ERROR - AMIGAHAN.68K EXPECTS THESE VALUES TO BE AT $B5A
  232.     ENDIF
  233.  
  234.     IF    @ >= $C00
  235.     ERROR - CHIN3, CHOUT3
  236.     ENDIF
  237.  
  238.     ORG    $C10        ;KLUDGE TO SKIP CHIN3, CHOUT3
  239.  
  240. COPLST1    DS.L    32        ;(7 bit planes *2 +2) *2 = 32
  241. COPLST2    DS.L    32        ;Second list is used when first is busy
  242. COPFLAG    DC.B    0        ;Flag used to double-buffer copper lists
  243.  
  244.     ORG    MEMTOP -$4000
  245.  
  246. ;----------------------------------------------------------------------
  247. ;MULTIPLY ROUTINES:
  248. ;
  249. ;Routine to multiply two signed, 32-bit numbers and produce a signed,
  250. ; 32-bit product.  D1:= D1 * D2  or  D1:= X * Y.
  251. ; Registers D0, D2, and A6 are destroyed.
  252. ;
  253. MUL1    MOVEA.W    D1,A6        ;(4) Save XL
  254.     MOVE.L    D1,D0        ;(4) Save XH
  255.     MULU    D2,D1        ;(70) D1:= XL * YL
  256.  
  257.     SWAP    D0        ;(4)
  258.     MULU    D2,D0        ;(70) D0:= XH * YL
  259.  
  260.     SWAP    D1        ;(4) Accumulator is word swapped
  261.     ADD.W    D0,D1        ;(4) Accumulate high words in D1
  262.  
  263.     MOVE.W    A6,D0        ;(4)
  264.     SWAP    D2        ;(4)
  265.     MULU    D2,D0        ;(70) D0:= XL * YH
  266.  
  267.     ADD.W    D0,D1        ;(4) Accumulate high word in D1
  268.     SWAP    D1        ;(4) Restore proper order
  269.     RTS            ;(16) Return product in D1
  270.                 ;(262) Total cycles, worst case
  271.  
  272. ;D2:= D2 * D3
  273. ; Registers D0, D3, and A6 are destroyed.
  274. MUL2    MOVEA.W    D2,A6
  275.     MOVE.L    D2,D0
  276.     MULU    D3,D2
  277.     SWAP    D0
  278.     MULU    D3,D0
  279.     SWAP    D2
  280.     ADD.W    D0,D2
  281.     MOVE.W    A6,D0
  282.     SWAP    D3
  283.     MULU    D3,D0
  284.     ADD.W    D0,D2
  285.     SWAP    D2
  286.     RTS
  287.  
  288. ;D3:= D3 * D4
  289. ; Registers D0, D4, and A6 are destroyed.
  290. MUL3    MOVEA.W    D3,A6
  291.     MOVE.L    D3,D0
  292.     MULU    D4,D3
  293.     SWAP    D0
  294.     MULU    D4,D0
  295.     SWAP    D3
  296.     ADD.W    D0,D3
  297.     MOVE.W    A6,D0
  298.     SWAP    D4
  299.     MULU    D4,D0
  300.     ADD.W    D0,D3
  301.     SWAP    D3
  302.     RTS
  303.  
  304. ;D4:= D4 * D5
  305. ; Registers D0, D5, and A6 are destroyed.
  306. MUL4    MOVEA.W    D4,A6
  307.     MOVE.L    D4,D0
  308.     MULU    D5,D4
  309.     SWAP    D0
  310.     MULU    D5,D0
  311.     SWAP    D4
  312.     ADD.W    D0,D4
  313.     MOVE.W    A6,D0
  314.     SWAP    D5
  315.     MULU    D5,D0
  316.     ADD.W    D0,D4
  317.     SWAP    D4
  318.     RTS
  319.  
  320. ;D5:= D5 * D6
  321. ; Registers D0, D6, and A6 are destroyed.
  322. MUL5    MOVEA.W    D5,A6
  323.     MOVE.L    D5,D0
  324.     MULU    D6,D5
  325.     SWAP    D0
  326.     MULU    D6,D0
  327.     SWAP    D5
  328.     ADD.W    D0,D5
  329.     MOVE.W    A6,D0
  330.     SWAP    D6
  331.     MULU    D6,D0
  332.     ADD.W    D0,D5
  333.     SWAP    D5
  334.     RTS
  335.  
  336. ;D6:= D6 * D7
  337. ; Registers D0, D7, and A6 are destroyed.
  338. MUL6    MOVEA.W    D6,A6
  339.     MOVE.L    D6,D0
  340.     MULU    D7,D6
  341.     SWAP    D0
  342.     MULU    D7,D0
  343.     SWAP    D6
  344.     ADD.W    D0,D6
  345.     MOVE.W    A6,D0
  346.     SWAP    D7
  347.     MULU    D7,D0
  348.     ADD.W    D0,D6
  349.     SWAP    D6
  350.     RTS
  351.  
  352. ;----------------------------------------------------------------------
  353. ;DIVIDE ROUTINES:
  354. ;
  355. ;D2:= D2 /D3
  356. ; Registers D0, D3, and A6 are destroyed.
  357. DIV2    EXG    D2,D1        ;Get numerator and save D1
  358.     EXG    D3,D2        ;Get denominator and save D2
  359.     BSR.S    DIV1        ;D1:= D1 /D2
  360.     MOVE.L    D3,D2        ;Restore D2
  361.     EXG    D1,D2        ;Get quotient and restore D1
  362.     RTS
  363.  
  364. ;D3:= D3 /D4
  365. ; Registers D0, D4, and A6 are destroyed.
  366. DIV3    EXG    D3,D1
  367.     EXG    D4,D2
  368.     BSR.S    DIV1
  369.     MOVE.L    D4,D2
  370.     EXG    D1,D3
  371.     RTS
  372.  
  373. ;D4:= D4 /D5
  374. ; Registers D0, D5, and A6 are destroyed.
  375. DIV4    EXG    D4,D1
  376.     EXG    D5,D2
  377.     BSR.S    DIV1
  378.     MOVE.L    D5,D2
  379.     EXG    D1,D4
  380.     RTS
  381.  
  382. ;D5:= D5 /D6
  383. ; Registers D0, D6, and A6 are destroyed.
  384. DIV5    EXG    D5,D1
  385.     EXG    D6,D2
  386.     BSR.S    DIV1
  387.     MOVE.L    D6,D2
  388.     EXG    D1,D5
  389.     RTS
  390.  
  391. ;D6:= D6 /D7
  392. ; Registers D0, D7, and A6 are destroyed.
  393. DIV6    EXG    D6,D1
  394.     EXG    D7,D2
  395.     BSR.S    DIV1
  396.     MOVE.L    D7,D2
  397.     EXG    D1,D6
  398.     RTS
  399.  
  400. ;----------------------------------------------------------------------
  401. ;Routine to do a signed, 32-bit divide.
  402. ; D1:= D1 /D2    remainder is in REMAIN
  403. ; (32 bits):= (32 bits) / (32 bits), remainder (32 bits)
  404. ; Registers D0, D2, and A6 are destroyed.
  405. ;
  406. DIV1    MOVE.L    D2,D0        ;(4) Get a copy of the denominator
  407.     BGT.S    DIV20        ;(10) Branch if it is greater than one
  408.     BEQ.S    DIV10        ;Branch if divide by zero
  409.     NEG.L    D2        ;Else, make denominator positive
  410.     BSR.S    DIV20        ;Do divide
  411.     NEG.L    D1        ;Reverse sign of quotient
  412.     RTS
  413.  
  414.  
  415. DIV10    JSR    VERROR
  416.     ASCII    '100 - DIVIDE BY 0'
  417.     DC.B    0
  418.  
  419.     MOVEQ    #$FFFFFFFF,D1    ;Return the best answer:
  420.     LSR.L    #1,D1        ;D1:= $7FFFFFFF
  421.     MOVE.L    D2,REMAIN    ; quotient = maximum, remainder = 0
  422.     RTS
  423.  
  424.  
  425. DIV20    TST.L    D1        ;(4) Is the numerator positive?
  426.     BPL.S    DIV30        ;(10) Branch if so
  427.     NEG.L    D1        ;Otherwise make it positive
  428.     BSR.S    DIV30        ;Do divide
  429.     NEG.L    D1        ;Make quotient negative
  430.     NEG.L    REMAIN        ;Make remainder negative
  431.     RTS
  432.  
  433.  
  434. ;D1:= D1 / D2
  435. ;Positive, 31-bit values.
  436. DIV30    SWAP    D0        ;Is denominator more than 16 bits?
  437.     TST.W    D0
  438.     BNE.S    DIV50        ;(8) Branch if so
  439.  
  440.     DIVU    D2,D1        ;(140) Attempt a simple divide
  441.     BVS.S    DIV40        ;(8) Branch if it didn't work
  442.  
  443.     MOVEQ    #0,D2        ;(4) Clear high word for the remainder
  444.     SWAP    D1        ;(4) Get the remainder into D2
  445.     MOVE.W    D1,D2        ;(4)
  446.     MOVE.L    D2,REMAIN    ;(16)
  447.     CLR.W    D1        ;(4) Clear high word of quotient
  448.     SWAP    D1        ;(4)
  449.     RTS
  450.     
  451.  
  452. ; D1:= D1 /D2
  453. ; (32 bits):= (32 bits) / (16 bits)
  454. ;
  455. ;     N       NH *2^16 + NL       NH          REM *2^16 + NL
  456. ;    ---  =  ---------------  =  ---- *2^16 + ----------------
  457. ;     D           D         D            D
  458. ;
  459. ; Where:
  460. ;    N = The 32-bit numerator
  461. ;    D = The 16-bit denominator
  462. ;    NH = The high word of the numerator
  463. ;    NL = The low word of the numerator
  464. ;    REM = The 16-bit remainder from NH/D
  465. ;
  466. ; Note: (REM *2^16 + NL) / D does not overflow because
  467. ;  (REM *2^16 + NL) < (D *2^16).
  468. ;
  469. DIV40    MOVE.W    D1,D0        ;Save the low word, NL
  470.     CLR.W    D1
  471.     SWAP    D1        ;Get the high word, NH
  472.     DIVU    D2,D1        ; /D
  473.  
  474.     MOVEA.W    D1,A6        ;Save the high quotient, QH, in A6
  475.     MOVE.W    D0,D1        ;QL = [REM *2^16 + NL] /D
  476.     DIVU    D2,D1
  477.  
  478.     SWAP    D1        ;Quotient = QH *2^16 + QL
  479.     MOVEQ    #0,D2
  480.     MOVE.W    D1,D2        ;Save remainder
  481.     MOVE.L    D2,REMAIN    ;(16)
  482.     MOVE.W    A6,D1        ;Combine QH with QL
  483.     SWAP    D1
  484.     RTS
  485.  
  486.  
  487. ;Check for some trivial cases
  488. ; D1:= D1 /D2
  489. DIV50    CMP.L    D1,D2        ;Compare denominator to numerator
  490.     BLT.S    DIV70
  491.     BEQ.S    DIV60
  492.  
  493.     MOVE.L    D1,REMAIN    ;Remainder = numerator
  494.     MOVEQ    #0,D1        ;Quotient = 0
  495.     RTS
  496.  
  497.  
  498. DIV60    MOVEQ    #1,D1        ;Quotient = 1
  499.     MOVEQ    #0,D2
  500.     MOVE.L    D2,REMAIN    ;Remainder = 0
  501.     RTS
  502.  
  503.  
  504. ;Handle the non-trivial case: LONG / LONG.
  505. ; D1:= D1 /D2,  $10000 <= D2 < D1
  506. ;The basic idea here is to shift D2 and D1 right until D2 < $10000. This
  507. ; allows the DIVU instruction to be used, which provides a quotient that
  508. ; is very nearly correct -- worst case it is only one count too large.
  509. ;
  510. DIV70    MOVE.L    D1,-(SP)    ;Save numerator
  511.     MOVEA.L    D2,A6        ;Save denominator
  512.  
  513.     MOVEQ    #15,D0        ;Scan for the most significant set bit
  514.     SWAP    D2        ; in the denominator
  515.     CMPI.W    #$100,D2
  516.     BGE.S    DIV80
  517.     MOVEQ    #7,D0
  518. DIV80
  519. DIV85    BTST    D0,D2
  520.     DBNE    D0,DIV85
  521.  
  522.     SWAP    D2        ;Restore D2
  523.     ADDQ.B    #1,D0
  524.     LSR.L    D0,D2        ;Shift numerator and denominator right
  525.     LSR.L    D0,D1        ; until the denominator fits in a word
  526.  
  527.     DIVU    D2,D1        ;Divide the truncated values
  528.     EXT.L    D1        ;Zero the high word of the quotient
  529.  
  530. ;Test numerator = Original denominator * truncated quotient
  531. ; (32) * (16) => (32)
  532.     MOVE.L    A6,D2        ;Get original denominator
  533.     MULU    D1,D2        ;Times tructated quotient
  534.     MOVE.L    A6,D0        ;Multiply the high word of denominator
  535.     SWAP    D0
  536.     MULU    D1,D0
  537.     SWAP    D2        ;Add partial products
  538.     ADD.W    D0,D2
  539.     SWAP    D2
  540.  
  541. ;Remainder = original numerator - test numerator
  542.     NEG.L    D2        ;Subtract test numerator
  543.     ADD.L    (SP)+,D2    ;Add the original numerator
  544.     BGE.S    DIV90        ;Branch if cool
  545.     SUBQ.W    #1,D1        ;Adjust quotient
  546.     ADD.L    A6,D2        ;Adjust remainder (add orig denominator)
  547. DIV90
  548.     MOVE.L    D2,REMAIN    ;(16)
  549.     RTS
  550.  
  551. ;----------------------------------------------------------------------
  552. ;Illegal intrinsic handler. (Note: this would be improved a tremendous
  553. ; amount if it said where it came from.)
  554. ;
  555. BADINT    JSR    VERROR
  556.     ASCII    '105 - ILLEGAL INTRINSIC'
  557.     DC.B    0
  558.     RTS
  559.  
  560. ;-----------------------------------------------------------------------
  561. ;0
  562. ;Return the absolute value of the argument in D0.
  563. ; I:= ABS(J)
  564. ;
  565. ABS    MOVE.L    (A5),D0
  566.     BPL.S    ABS10
  567.     NEG.L    D0
  568. ABS10    RTS
  569.  
  570. ;-----------------------------------------------------------------------
  571. ;1
  572. ;Return a random number, between 0 and the argument-1, in D0.
  573. ; If the argument = 0, then the seeds are reinitialized (for a
  574. ; repeatable sequence). If the argument < 0 then randomize and
  575. ; return a positive value between 0 and -(argument-1).
  576. ; I:= RAN(10)
  577. ; *** THIS IS CURRENTLY A 16-BIT OPERATION ***
  578. ;
  579. RAN    TST.L    (A5)        ;Is the argument = 0
  580.     BNE.S    RANF10        ;Branch if not
  581.     BSR.S    RANINI        ;Initialize seeds
  582.     MOVEQ    #0,D0        ;Return 0
  583.     BRA.S    RANF90
  584.  
  585. RANF10    BPL.S    RANF20        ;Branch if the argument is positive
  586.     MOVE.L    HASH,RANM    ;Randomize with keyboard spinner
  587.     NEG.L    (A5)        ;Return a positive random number
  588.  
  589. RANF20    BSR.S    RANDOM        ;Get a random number
  590.     DIVS    2(A5),D0    ;D0:= REM(D0 / 2(A5))
  591.     CLR.W    D0        ;Clear quotient
  592.     SWAP    D0        ;Get remainder into low word
  593. RANF90    RTS
  594.  
  595. ;
  596. ;Initialize the random number seeds
  597. ;
  598. RANINI    MOVE.L    #2537,RANK    ;Reinitialize the seeds
  599.     MOVE.L    #5149,RANL
  600.     MOVE.L    #7026,RANM
  601.     RTS
  602.  
  603. ;
  604. ;Return a random number, between 0 and 10860, in D0.
  605. ;*** should be increased to 32 bit values ***    ????
  606. ;
  607. MODK    EQU    10909        ;Modulo values (prime numbers)
  608. MODL    EQU    10891
  609. MODM    EQU    10861
  610.  
  611. RANDOM    MOVE.L    RANK,D0        ;RANK:=2*RANK modulo MODK
  612.     ADD.L    D0,D0
  613.     CMP.L    #MODK,D0
  614.     BLT.S    RAN10
  615.     SUB.L    #MODK,D0
  616. RAN10    MOVE.L    D0,RANK
  617.  
  618.     MOVE.L    RANL,D0        ;RANL:=2*RANL modulo MODL
  619.     ADD.L    D0,D0
  620.     CMP.L    #MODL,D0
  621.     BLT.S    RAN20
  622.     SUB.L    #MODL,D0
  623. RAN20    MOVE.L    D0,RANL
  624.  
  625.     ADD.L    RANK,D0        ;RANM:= (RANK+RANL+RANM) modulo MODM
  626.     ADD.L    RANM,D0
  627. RAN30    CMP.L    #MODM,D0
  628.     BLT.S    RAN99
  629.     SUB.L    #MODM,D0
  630.     BRA.S    RAN30
  631.  
  632. RAN99    MOVE.L    D0,RANM
  633.     RTS
  634.  
  635. ;-----------------------------------------------------------------------
  636. ;2
  637. ;Return the remainder of the last integer divide in D0.
  638. ; The sign of the remainder is always the same as the dividend unless
  639. ; the dividend is equal to zero.
  640. ; I:= REM(5/3)
  641. ;
  642. REM    MOVE.L    REMAIN,D0    ;Get the remainder
  643.     RTS
  644.  
  645. ;-----------------------------------------------------------------------
  646. ;3
  647. ;Reserve heap space for an array (A5:= A5 + <ARG>).
  648. ; ADDR:= RESERVE(BYTES)
  649. ; The starting (low) address of the reserved space in returned in D0.
  650. ;WARNING: This assumes that the heap and the stack are arranged so that
  651. ; they grow toward each other.
  652. ;
  653. RESERV    MOVE.L    A5,D0        ;Return the base address in D0
  654.     BTST    #0,3(A5)    ;Make sure he is reserving an even
  655.     BEQ.S    RES10        ; number of bytes, branch if so
  656.     ADDQ.B    #1,3(A5)    ;Add one more byte to make it even
  657. RES10
  658.     ADDA.L    (A5),A5        ;Add the argument number of bytes
  659.                 ; to the heap pointer (A5)
  660.     CMPA.L    SP,A5        ;Check for memory overflow
  661.     BLO.S    RES90
  662.     JSR    VERROR
  663.     ASCII    '102 - MEMORY OVERFLOW'
  664.     DC.B    0
  665. RES90    RTS
  666.  
  667. ;-----------------------------------------------------------------------
  668. ;4
  669. ;Swap bytes in a word.
  670. ; The swapped bytes of the argument are returned in D0.
  671. ; I:= SWAP($3412)
  672. ;
  673. SWAP    MOVE.L    (A5),D0
  674.     ROL.W    #8,D0
  675.     RTS
  676.  
  677. ;-----------------------------------------------------------------------
  678. ;5
  679. ;Extend the sign bit of a byte to 32 bits (a long word).
  680. ; The sign-extended argument is returned in D0.
  681. ; I:= EXTEND($80)
  682. ;
  683. EXTEND    MOVE.B    3(A5),D0
  684.     EXT.W    D0
  685.     EXT.L    D0
  686.     RTS
  687.  
  688. ;-----------------------------------------------------------------------
  689. ;6
  690. ;Restart the current (XPL) program.
  691. ; RESTART
  692. ;
  693. RESTAR    ST    RERUNF        ;Set the RERUN flag
  694.     CLR.L    ERRLOC        ;Indicate no errors
  695.     MOVEA.L    STACK,SP    ;Set the stack pointer
  696.     MOVEA.L    HEAP,A5        ;Set the heap pointer
  697.     JSR    VRSTRT        ;Call the current program
  698.     JSR    VSHOERR        ;Display any errors
  699.     JMP    VEXIT        ;Take the program's exit vector
  700.  
  701. ;-----------------------------------------------------------------------
  702. ;7
  703. ;Return a byte from input device DEV in D0.
  704. ; BYTE:= CHIN(DEV);
  705. ;
  706. CHIN    MOVE.B    3(A5),DEVICE    ;Get the device number
  707.     BRA    BYTEIN        ;(PBRA) returns with byte in D0
  708.  
  709. ;-----------------------------------------------------------------------
  710. ;8
  711. ;Send a byte to device DEV.
  712. ; CHOUT(DEV,BYTE);
  713. ; A6 and D0 are destroyed.
  714. ;
  715. CHOUT    MOVE.B    3(A5),DEVICE    ;Get the device number
  716.     MOVE.B    7(A5),D0    ;Get the character
  717.     MOVEA.W    #12,A6        ;Set the function code = CHOUT
  718.     JMP    VDEVHAN        ;(PJMP) output D0
  719.  
  720. ;-----------------------------------------------------------------------
  721. ;9
  722. ;Send a "new line" command to DEV
  723. ; CRLF(DEV)
  724. ; A6 and D0 are destroyed.
  725. ;
  726. CRLF    MOVE.B    3(A5),DEVICE    ;Get the device number
  727.     MOVEQ    #CR,D0        ;CR = new line (LF is not used)
  728.     MOVEA.W    #12,A6        ;Set the function code = CHOUT
  729.     JMP    VDEVHAN        ;(PJMP) do I/O
  730.  
  731. ;-----------------------------------------------------------------------
  732. ;10
  733. ;Get a signed, decimal ASCII string from device DEV, convert it to a
  734. ; binary long word, and return it in D0.
  735. ; I:= INTIN(DEV)
  736. ;
  737. INTIN    MOVE.B    3(A5),DEVICE    ;Get the device number
  738.     BRA    INTI        ;(PBRA) return the integer in D0
  739.  
  740. ;-----------------------------------------------------------------------
  741. ;11
  742. ;Convert a 32-bit integer to a signed, decimal ASCII string and send it
  743. ; out to device DEV.
  744. ; INTOUT(DEV,I)
  745. ; D0 is destroyed.
  746. ;
  747. INTOUT    MOVE.B    3(A5),DEVICE    ;Get the device number
  748.     MOVE.L    4(A5),D0    ;Get the integer
  749.     BRA    INTO        ;(PBRA) output the integer
  750.  
  751. ;-----------------------------------------------------------------------
  752. ;12
  753. ;Output the ASCII string at address ADDR to I/O device DEV.
  754. ; TEXT(DEV,ADDR)
  755. ; A6 is destroyed.
  756. ;
  757. TEXT    MOVE.B    3(A5),DEVICE    ;Get the device number
  758.     MOVEA.L    4(A5),A6    ;Get the address
  759.     BRA    TEXTO        ;(PBRA) output the string
  760.  
  761. ;-----------------------------------------------------------------------
  762. ;13
  763. ;Open (initialize) a device for input.
  764. ; OPENI(DEV)
  765. ; A6 is destroyed.
  766. ;
  767. OPENI    MOVE.B    3(A5),DEVICE    ;Get the device number
  768.     MOVEA.W    #0,A6        ;Set the function code = OPENI
  769.     JMP    VDEVHAN        ;(PJMP) do I/O
  770.  
  771. ;-----------------------------------------------------------------------
  772. ;14
  773. ;Open (initialize) a device for output.
  774. ; OPENO(DEV)
  775. ; A6 is destroyed.
  776. ;
  777. OPENO    MOVE.B    3(A5),DEVICE    ;Get the device number
  778.     MOVEA.W    #4,A6        ;Set the function code = OPENO
  779.     JMP    VDEVHAN        ;(PJMP) do I/O
  780.  
  781. ;-----------------------------------------------------------------------
  782. ;15
  783. ;Close an output device (flushes buffers, etc.)
  784. ; CLOSE(DEV)
  785. ; A6 is destroyed.
  786. ;
  787. CLOSE    MOVE.B    3(A5),DEVICE    ;Get the device number
  788.     MOVEA.W    #16,A6        ;Set the function code = CLOSE
  789.     JMP    VDEVHAN        ;(PJMP) do I/O
  790.  
  791. ;-----------------------------------------------------------------------
  792. ;16
  793. ;Abort the XPL program (same as a CTRL-P exit)
  794. ; ABORT
  795. ;
  796. ABORT    JMP    VABORT
  797.  
  798. ;-----------------------------------------------------------------------
  799. ;17
  800. ;Turn system error trapping on or off as indicated.
  801. ; TRAP('FALSE')
  802. ;
  803. TRAP    MOVE.B    #FALSE,ERRTRAP    ;Assume it is false (=0)
  804.     TST.L    (A5)
  805.     BEQ.S    TR90
  806.     ST    ERRTRAP        ;Set it true if any bit was set
  807. TR90    RTS
  808.  
  809. ;-----------------------------------------------------------------------
  810. ;18
  811. ;Return the amount of free space left in the heap and the stack.
  812. ; WARNING: It is assumed here that the stack and the heap are set up
  813. ; such that they grow toward each other.
  814. ; I := FREE
  815. ;
  816. FREE    MOVE.L    SP,D0        ;RETURN (SP - A5)
  817.     SUB.L    A5,D0
  818.     RTS
  819.  
  820. ;-----------------------------------------------------------------------
  821. ;19
  822. ;Return the rerun flag
  823. ; FLAG := RERUN
  824. ;
  825. RERUN    MOVE.B    RERUNF,D0
  826.     EXT.W    D0
  827.     EXT.L    D0
  828.     RTS
  829.  
  830. ;-----------------------------------------------------------------------
  831. ;20
  832. ;Return the heap pointer
  833. ; ADDR := GETHP
  834. ;
  835. GETHP    MOVE.L    A5,D0
  836.     RTS
  837.  
  838. ;-----------------------------------------------------------------------
  839. ;21
  840. ;Set the heap pointer.
  841. ; SETHP($2000)
  842. ; (The user had better have a good idea of the functioning of XPL before
  843. ; dinging with the heap pointer or he will surely bomb himself!)
  844. ; A6 is destroyed.
  845. ;
  846. SETHP    MOVEA.L    (A5),A5
  847.     RTS
  848.  
  849. ;-----------------------------------------------------------------------
  850. ;22
  851. ;Return 'TRUE' if an error has been detected. (Traps must be turned off
  852. ; using intrinsic 17 for this to occur.)
  853. ; I:= GETERR;
  854. ;
  855. GETERR    MOVEQ    #FALSE,D0    ;Assume no error
  856.     TST.L    ERRLOC        ;ERRLOC = 0 if no error is detected
  857.     BEQ.S    GE10
  858.     MOVEQ    #TRUE,D0
  859. GE10    CLR.L    ERRLOC        ;Clear any possible error
  860.     RTS
  861.  
  862. ;-----------------------------------------------------------------------
  863. ;23
  864. ;Move cursor of device 0 to column X, line Y. Upper left corner is
  865. ;  X,Y = 0,0.
  866. ; CURSOR(X,Y)
  867. ; A6 is destroyed.
  868. ;
  869. CURSOR    MOVE.B    #0,DEVICE    ;Set to device number 0
  870.  
  871.     MOVE.B    3(A5),D0    ;Get X position
  872.     ROL.W    #8,D0        ;Put it into high byte of D0
  873.     MOVE.B    7(A5),D0    ;Get Y position into low byte
  874.  
  875.     MOVEA.W    #28,A6        ;Set function code = "position cursor"
  876.     JMP    VDEVHAN        ;(PJMP) do I/O
  877.  
  878. ;-----------------------------------------------------------------------
  879. ;24
  880. ;Scan the directory for a file name and return its start and end blocks
  881. ; SCAN(UNIT, INFO, NAME)
  882. ;    UNIT - unit number (0-7)
  883. ;    INFO - the address of a 2-integer array where the starting and
  884. ;        ending blocks are returned
  885. ;    NAME - the address of a 12-byte file name
  886. ;        (note: the 11th byte cannot have its MSB set)
  887. ;
  888. SCAN    MOVE.B    3(A5),UNIT    ;Get the unit argument
  889.     MOVEA.L    8(A5),A6    ;Point A6 to the file name
  890.     JSR    VFSCAN        ;Scan for the name (heap is not used)
  891.  
  892.     MOVEA.L    4(A5),A6    ;Get the address of the info array
  893.     MOVE.L    BLKNO,(A6)    ;Put the start and end blocks into it
  894.     MOVE.L    ENDBLK,4(A6)
  895.     RTS
  896.  
  897. ;-----------------------------------------------------------------------
  898. ;25
  899. ;Set the RERUN flag
  900. ; SETRUN('TRUE')
  901. ;
  902. SETRUN    MOVE.B    #FALSE,RERUNF    ;Assume it is false (=0)
  903.     TST.L    (A5)
  904.     BEQ.S    SR90
  905.     ST    RERUNF        ;Set it true if any bit was set
  906. SR90    RTS
  907.  
  908. ;-----------------------------------------------------------------------
  909. ;26
  910. ;Get a hex ASCII string from device DEV, convert it to a binary word,
  911. ; and return it in D0.
  912. ; I:= HEXIN(DEV)
  913. ;
  914. HEXIN    MOVE.B    3(A5),DEVICE    ;Get the device number
  915.     BRA    HEXI        ;(PBRA) get the hex integer in D0
  916.  
  917. ;-----------------------------------------------------------------------
  918. ;27
  919. ;Convert a 32-bit integer to an unsigned, hex ASCII string and send it
  920. ; out to device DEV.
  921. ; HEXOUT(DEV,I)
  922. ;
  923. HEXOUT    MOVE.B    3(A5),DEVICE    ;Get the device number
  924.     MOVE.L    4(A5),D0    ;Get the integer
  925.     BRA    HEXO        ;(PBRA) output the hex integer
  926.  
  927. ;-----------------------------------------------------------------------
  928. ;28
  929. ;Run a .SAV file
  930. ; CHAIN(UNIT, BLKNO)
  931. ;
  932. CHAIN    MOVE.B    3(A5),UNIT    ;Get the arguments
  933.     MOVE.L    4(A5),BLKNO
  934.     JMP    VFRUN        ;Go run it (never returns)
  935.  
  936. ;-----------------------------------------------------------------------
  937. ;29
  938. ;Open a disk file for input
  939. ; OPENF(UNIT, INFO);
  940. ;    UNIT - unit number (0-7)
  941. ;    INFO - the address of a 2-integer array containing the starting
  942. ;        and ending blocks (usually gotten from SCAN)
  943. ;
  944. OPENF    MOVE.B    3(A5),INUNT    ;Set the input unit
  945.  
  946.     MOVEA.L    4(A5),A6    ;Get the address of the array
  947.     MOVE.L    (A6),INLBLK    ;Set the starting block number
  948.     MOVE.L    4(A6),INHBLK    ;Set the ending block number
  949.     MOVE.B    #1,INFLG    ;1 = SETUP
  950.  
  951.     MOVE.B    #3,DEVICE    ;Open the disk file for input
  952.     MOVEA.W    #0,A6        ;Set the function code = OPENI
  953.     JMP    VDEVHAN        ;(PJMP) do I/O
  954.  
  955. ;-----------------------------------------------------------------------
  956. ;30
  957. ;Write the memory at BUFFER to UNIT for SIZE many BLOCKS
  958. ; WRITE(UNIT, BLOCK, BUFFER, SIZE)
  959. ;
  960. WRITE    MOVE.B    3(A5),UNIT    ;Get the arguments
  961.     MOVE.L    4(A5),BLKNO
  962.     MOVE.L    8(A5),FADDR
  963.     MOVE.L    12(A5),NBLKS
  964.     MOVEA.W    #12,A6        ;Set "write" function code
  965.     JMP    VUNTHAN        ;(PJMP) perform the unit function code
  966.  
  967. ;-----------------------------------------------------------------------
  968. ;31
  969. ;Read into the memory at BUFFER FROM UNIT for SIZE many BLOCKS
  970. ; READ(UNIT, BLOCK, BUFFER, SIZE)
  971. ;
  972. READ    MOVE.B    3(A5),UNIT    ;Get the arguments
  973.     MOVE.L    4(A5),BLKNO
  974.     MOVE.L    8(A5),FADDR
  975.     MOVE.L    12(A5),NBLKS
  976.     MOVEA.W    #8,A6        ;Set "read" function code
  977.     JMP    VUNTHAN        ;(PJMP) perform the unit function code
  978.  
  979. ;-----------------------------------------------------------------------
  980. ;32
  981. ;COLOR:=TESTPT(X, Y)
  982. TESTPT    RTS
  983.  
  984. ;-----------------------------------------------------------------------
  985. ;33
  986. ;Load a memory image and enter the monitor
  987. ; FGET(UNIT,BLKNO)
  988. ;
  989. FGET    MOVE.B    3(A5),UNIT    ;Get arguments
  990.     MOVE.L    4(A5),BLKNO
  991.     JMP    VFGET        ;(Never returns)
  992.  
  993. ;-----------------------------------------------------------------------
  994. ;35
  995. ;Write a memory image for a .SAV file
  996. ; FSAVE(UNIT,BLKNO)
  997. ;
  998. FSAVE    MOVE.B    3(A5),UNIT    ;Get arguments
  999.     MOVE.L    4(A5),BLKNO
  1000.     JMP    VFSAVE        ;(Never returns)
  1001.  
  1002. ;-----------------------------------------------------------------------
  1003. ;36
  1004. ;Routine to quickly move a block of memory.
  1005. ; Move SIZE many bytes from FROM to TO
  1006. ; BLIT(FROM, TO, SIZE)
  1007. ; (Don't use the blitter because it only works with chip memory.)
  1008. ;
  1009. BLIT    MOVEM.L    D1/A0,-(SP)    ;Save register(s)
  1010.                 ;Get arguments:
  1011.     MOVEA.L    (A5),A0        ; FROM
  1012.     MOVEA.L    4(A5),A6    ; TO
  1013.     MOVE.L    8(A5),D0    ; SIZE
  1014.     MOVE.L    D0,D1        ;Put the high 16 bits of SIZE into
  1015.     SWAP    D1        ; a second counter, D1
  1016.  
  1017.     CMPA.L    A0,A6        ;If TO > FROM (i.e: moving forward in
  1018.     BEQ.S    BLIT90        ; memory) then don't branch
  1019.     BLO.S    BLIT20        ;Enter loop checking for SIZE = 0
  1020.  
  1021.     ADDA.L    D0,A6        ;Move starting at the end of the block
  1022.     ADDA.L    D0,A0        ;Add SIZE to TO and FROM
  1023.     BRA.S    BLIT40        ;Enter loop checking for SIZE = 0
  1024.  
  1025. BLIT10    MOVE.B    (A0)+,(A6)+    ;Move block backward, pointers forward
  1026. BLIT20    DBF    D0,BLIT10    ;Loop until D0 = -1
  1027.     DBF    D1,BLIT10    ; and also D1 = -1
  1028.     BRA.S    BLIT90        ;Exit
  1029.  
  1030. BLIT30    MOVE.B    -(A0),-(A6)    ;Move block forward, pointers backward
  1031. BLIT40    DBF    D0,BLIT30    ;Loop until D0 = -1
  1032.     DBF    D1,BLIT30    ; and also D1 = -1
  1033.  
  1034. BLIT90    MOVEM.L    (SP)+,D1/A0    ;Restore register(s)
  1035.     RTS
  1036.  
  1037. ;----------------------------------------------------------------------
  1038. ;37
  1039. ;Return "true" if specified mouse button is pressed
  1040. ; BOOLEAN:=BUTTON(NUMBER)
  1041. ;
  1042. CIAA    EQU    $BFE001
  1043.  
  1044. BUTTON    MOVE.W    2(A5),D0    ;0 = Port 1, left button
  1045.     BNE.S    BUT10
  1046.     BTST    #6,CIAA.L
  1047.     BEQ.S    BTRUE
  1048.     BRA.S    BFALSE
  1049. BUT10
  1050.     CMPI.W    #1,D0        ;1 = Port 1, right button
  1051.     BNE.S    BUT20
  1052.     NOP            ;NOT IMPLEMENTED
  1053.     BRA.S    BFALSE
  1054. BUT20
  1055.     CMPI.W    #2,D0        ;2 = Port 2, left button
  1056.     BNE.S    BUT30
  1057.     BTST    #7,CIAA.L
  1058.     BEQ.S    BTRUE
  1059.     BRA.S    BFALSE
  1060. BUT30
  1061.     CMPI.W    #3,D0        ;3 = Port 2, right button
  1062.     BNE.S    BFALSE
  1063.     NOP            ;NOT IMPLEMENTED
  1064.  
  1065. BFALSE    MOVEQ    #FALSE,D0    ;Return "false"
  1066.     RTS
  1067.  
  1068. BTRUE    MOVEQ    #TRUE,D0    ;Return "true"
  1069.     RTS
  1070.  
  1071. ;----------------------------------------------------------------------
  1072. ;38
  1073. ;Returns "true" if specified joystick direction (DIR) is pressed
  1074. ; if JOYSTICK(DIR) then ...
  1075. ;
  1076. ;        LEFT PORT           RIGHT PORT
  1077. ;
  1078. ;        2            6
  1079. ;        |            |
  1080. ;       3 ---+--- 1           7 ---+--- 5
  1081. ;        |            |
  1082. ;        0            4
  1083. ;
  1084. JOY0DAT    EQU    $DFF00A        ;Chip register addresses
  1085. JOY1DAT    EQU    $DFF00C
  1086.  
  1087. JOYSTICK
  1088.     MOVEM.W    D1/D2,-(SP)    ;Save registers
  1089.  
  1090.     MOVE.W    2(A5),D0    ;Get specified direction, DIR
  1091.     MOVE.W    JOY1DAT.L,D1    ;Assume right port
  1092.     BTST    #2,D0
  1093.     BNE.S    JOY05
  1094.     MOVE.W    JOY0DAT.L,D1    ;Use left port
  1095. JOY05
  1096.     BTST    #0,D0        ;if DIR & 1 then...
  1097.     BEQ.S    JOY20
  1098.  
  1099.     BTST    #1,D0        ;if DIR & 2 then
  1100.     BEQ.S    JOY10
  1101.     BTST    #9,D1        ; return (DATA & $0200) # 0       \3 <--
  1102.     BRA.S    JOY90
  1103. JOY10
  1104.     BTST    #1,D1        ; else return (DATA & $0002) # 0   \1 -->
  1105.     BRA.S    JOY90
  1106. JOY20
  1107.     MOVE.W    D1,D2        ;DATA:= DATA>>1 | DATA;
  1108.     LSR.W    #1,D2
  1109.     EOR.W    D2,D1
  1110.  
  1111.     BTST    #1,D0        ;if DIR & 2 then
  1112.     BEQ.S    JOY30
  1113.     BTST    #8,D1        ; return (DATA & $0100) # 0   \2 Forward
  1114.     BRA.S    JOY90
  1115. JOY30
  1116.     BTST    #0,D1        ; else return (DATA & $0001) # 0 \0 Back
  1117.  
  1118. JOY90    MOVEM.W    (SP)+,D1/D2    ;Restore regs without changing status
  1119.     BNE.S    JTRUE
  1120.     MOVEQ    #FALSE,D0    ;Return "false"
  1121.     RTS
  1122.  
  1123. JTRUE    MOVEQ    #TRUE,D0    ;Return "true"
  1124.     RTS
  1125.  
  1126. ;-----------------------------------------------------------------------
  1127. ;39
  1128. ;SOUND(VOLUME, CYCLES, PERIOD);
  1129. SOUND    RTS
  1130.  
  1131. ;-----------------------------------------------------------------------
  1132. ;40
  1133. ;Clear the current graphics bit map.
  1134. ;
  1135. CLEAR    BRA    DOCLEAR        ;(PBRA)
  1136.  
  1137. ;-----------------------------------------------------------------------
  1138. ;41
  1139. ;Plot a point at X,Y on the current bit map. "COLOR" selects a color
  1140. ; register. It also specifys complement and "fast" modes.
  1141. ; POINT(X, Y, COLOR)
  1142. ;
  1143. POINT    MOVE.L    (A5),D0
  1144.     BSR    REMAPX
  1145.     MOVE.L    D0,X0
  1146.  
  1147.     MOVE.L    4(A5),D0
  1148.     BSR    REMAPY
  1149.     MOVE.L    D0,Y0
  1150.  
  1151.     MOVE.L    8(A5),COLOR
  1152.     BRA    DOPOINT        ;(PBRA) Plot a point at X0,Y0
  1153.  
  1154. ;-----------------------------------------------------------------------
  1155. ;42
  1156. ;Draw a straight line from X0,Y0 to X,Y on the current bit map. "COLOR"
  1157. ; selects a color register, modes, and 16 bits of texture. The texture
  1158. ; is complemented, for example, 16 zero bits gives a solid line.
  1159. ; LINE(X, Y, COLOR)
  1160. ;
  1161. LINE    MOVE.L    (A5),D0
  1162.     BSR    REMAPX
  1163.     MOVE.L    D0,X1
  1164.  
  1165.     MOVE.L    4(A5),D0
  1166.     BSR    REMAPY
  1167.     MOVE.L    D0,Y1
  1168.  
  1169.     MOVE.L    8(A5),COLOR
  1170.     BSR    DOLINE        ;Draw line from X0,Y0 to X1,Y1
  1171.  
  1172.     MOVE.L    X1,X0        ;Resume where we left off
  1173.     MOVE.L    Y1,Y0
  1174.     RTS
  1175.  
  1176. ;-----------------------------------------------------------------------
  1177. ;43
  1178. ;Move to the start of a line.
  1179. ; MOVE(X, Y)
  1180. ;
  1181. MOVE    MOVE.L    (A5),D0
  1182.     BSR    REMAPX
  1183.     MOVE.L    D0,X0
  1184.  
  1185.     MOVE.L    4(A5),D0
  1186.     BSR    REMAPY
  1187.     MOVE.L    D0,Y0
  1188.     RTS
  1189.  
  1190. ;======================================================================
  1191. ;FLOATING POINT ROUTINES:
  1192. ;-----------------------------------------------------------------------
  1193. ;46
  1194. ;Reserve heap space for a real array
  1195. ; A5:= A5 + ARG *RLSIZE
  1196. ; ADDR:= RLRES(REALS)
  1197. ; The starting (low) address of the reserved space in returned in FP0.
  1198. ;WARNING: This assumes that the heap and the stack are arranged so that
  1199. ; they grow toward each other. This also assumes 8 bytes in a real.
  1200. ;
  1201. RLRES    MOVE.L    A5,D0        ;Return the base address in FP0
  1202.     DC.W    $F200, $4000    ;FMOVE.L D0,FP0   (FLOAT)
  1203.     MOVE.L    (A5),D0        ;Get the number of reals to reserve
  1204.     LSL.L    #3,D0        ;Times 8 to get the number of bytes
  1205.     ADDA.L    D0,A5        ;Add the argument number of bytes
  1206.                 ; to the heap pointer (A5)
  1207.     CMPA.L    SP,A5        ;Check for memory overflow
  1208.     BLO.S    RRES90
  1209.     JSR    VERROR
  1210.     ASCII    '103 - MEMORY OVERFLOW'
  1211.     DC.B    0
  1212. RRES90    RTS
  1213.  
  1214. ;-----------------------------------------------------------------------
  1215. ;47
  1216. ; X:= RLIN(DEV);
  1217. ;
  1218. RLIN    BRA    BADINT
  1219.  
  1220. ;-----------------------------------------------------------------------
  1221. ;48
  1222. ; RLOUT(DEV,X);
  1223. ;
  1224. RLOUT    BRA    BADINT
  1225.  
  1226. ;-----------------------------------------------------------------------
  1227. ;49
  1228. ;X:= FLOAT(I);
  1229. ;(FMOVE.L -8(SP),FP0 is not implemented in FPP.68K)
  1230. ;
  1231. FLOAT    MOVE.L    (A5),D0
  1232.     DC.W    $F200, $4000    ;FMOVE.L D0,FP0
  1233.     RTS
  1234.  
  1235. ;-----------------------------------------------------------------------
  1236. ;50
  1237. ;I:= FIX(X);
  1238. ;
  1239. FIX    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  1240.     DC.W    $F200, $6000    ;FMOVE.L FP0,D0
  1241.     RTS
  1242.  
  1243. ;-----------------------------------------------------------------------
  1244. ;51
  1245. ;X:= RLABS(X);
  1246. ;
  1247. RLABS    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  1248.     DC.W    $F200, $0018    ;FABS.X FP0
  1249.     RTS
  1250.  
  1251. ;-----------------------------------------------------------------------
  1252. ;52
  1253. ;FORMAT(M,N);
  1254. ;
  1255. FORMAT    BRA    BADINT
  1256.  
  1257. ;-----------------------------------------------------------------------
  1258. ;53
  1259. ;X:= SQRT(X);
  1260. ;(FSQRT.D (A5),FP0 et cetra are not implemented in FPP.68K)
  1261. ;
  1262. SQRT    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  1263.     DC.W    $F200, $0004    ;FSQRT.X FP0
  1264.     RTS
  1265.  
  1266. ;-----------------------------------------------------------------------
  1267. ;54
  1268. ;X:= LN(X);
  1269. ;
  1270. LN    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  1271.     DC.W    $F200, $0014    ;FLOGN.X FP0
  1272.     RTS
  1273.  
  1274. ;-----------------------------------------------------------------------
  1275. ;55
  1276. ;X:= EXP(X);
  1277. ;
  1278. EXP    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  1279.     DC.W    $F200, $0010    ;FETOX.X FP0
  1280.     RTS
  1281.  
  1282. ;-----------------------------------------------------------------------
  1283. ;56
  1284. ;X:= SIN(X);
  1285. ;
  1286. SIN    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  1287.     DC.W    $F200, $000E    ;FSIN.X FP0
  1288.     RTS
  1289.  
  1290. ;-----------------------------------------------------------------------
  1291. ;57
  1292. ;X:= ATAN2(Y,X);
  1293. ;
  1294. ATAN2    BRA    BADINT
  1295.  
  1296. ;-----------------------------------------------------------------------
  1297. ;58
  1298. ;X:= MOD(A,B);
  1299. ;
  1300. MOD    BRA    BADINT
  1301.  
  1302. ;-----------------------------------------------------------------------
  1303. ;59
  1304. ;X:= LOG(X);
  1305. ;
  1306. LOG    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  1307.     DC.W    $F200, $0015    ;FLOG10.X FP0
  1308.     RTS
  1309.  
  1310. ;-----------------------------------------------------------------------
  1311. ;60
  1312. ;X:= COS(X);
  1313. ;
  1314. COS    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  1315.     DC.W    $F200, $001D    ;FCOS.X FP0
  1316.     RTS
  1317.  
  1318. ;-----------------------------------------------------------------------
  1319. ;61
  1320. ;X:= TAN(X);
  1321. ;
  1322. TAN    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  1323.     DC.W    $F200, $000F    ;FTAN.X FP0
  1324.     RTS
  1325.  
  1326. ;-----------------------------------------------------------------------
  1327. ;62
  1328. ;X:= ASIN(X);
  1329. ;
  1330. ASIN    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  1331.     DC.W    $F200, $000C    ;FACOS.X FP0
  1332.     RTS
  1333.  
  1334. ;-----------------------------------------------------------------------
  1335. ;63
  1336. ;X:= ACOS(X);
  1337. ;
  1338. ACOS    DC.W    $F215, $5400    ;FMOVE.D (A5),FP0
  1339.     DC.W    $F200, $001C    ;FACOS.X FP0
  1340.     RTS
  1341.  
  1342. ;-----------------------------------------------------------------------
  1343. ;64
  1344. ;Set the backup flag, so the next CHIN will reread the same byte.
  1345. ; BACKUP
  1346. ;
  1347. BACKUP    ST    BACKFL        ;Set on condition true, i.e. always
  1348.     RTS
  1349.  
  1350. ;======================================================================
  1351. ;65
  1352. ; HICHAR(X, Y, MODE, ROT, CHAR)
  1353. ;
  1354. HICHAR    RTS
  1355.  
  1356. ;-----------------------------------------------------------------------
  1357. ;66
  1358. ;Return the value of the byte in the Apple at the given address
  1359. ; BYTE:=PEEK(ADDRESS)
  1360. ;
  1361. PEEK    RTS
  1362.  
  1363. ;-----------------------------------------------------------------------
  1364. ;67
  1365. ;Store the byte at the given address.
  1366. ; POKE(ADDR,BYTE)
  1367. ;
  1368. POKE    RTS
  1369.  
  1370. ;----------------------------------------------------------------------
  1371. ;108
  1372. ;Define the bit map location and dimensions for POINT, LINE and CLEAR.
  1373. ; (Note that this bit map might not be displayed immediately.)
  1374. ; BITMAP(ADDR, WIDTH, HEIGHT, DEPTH)
  1375. ;   ADDR is the memory location of bit map.
  1376. ;     Use: RESERVE(WIDTH /8 *HEIGHT *DEPTH)
  1377. ;   WIDTH should be either 320, 640, or a larger value up to 1024. It
  1378. ;     must always be evenly divisible by 16, because of CLEAR.
  1379. ;   HEIGHT should be in the range 200 through 1024.
  1380. ;   DEPTH should be in the range 1 through 6.
  1381. ; WIDTH and HEIGHT should always be equal to or greater than the
  1382. ; displayed view.
  1383. ;
  1384. BITMAP    MOVE.L    (A5),RASTER
  1385.     MOVE.L    4(A5),WIDTH
  1386.     MOVE.L    8(A5),HEIGHT
  1387.     MOVE.L    12(A5),DEPTH
  1388.  
  1389. ;    ANDI.W    #$03FF,D0    ; after shifting right 4 bits
  1390. ;    BEQ.S    CLR10        ;Branch if ok
  1391. ;    JSR    VERROR
  1392. ;    ASCII    "106 - BAD RASTER DIMENSIONS"
  1393. ;    DC.B    0
  1394. ;    BRA.S    CLR60        ;Give it our best shot
  1395. ;CLR10
  1396.  
  1397.     RTS
  1398.  
  1399. ;----------------------------------------------------------------------
  1400. ;109
  1401. ;Define the scale factors and offsets for coordinates used by POINT,
  1402. ; LINE and CLEAR.
  1403. ; BITMAP2(MAGX, MAGY, OFFSETX, OFFSETY, INVERTX, INVERTY)
  1404. ;
  1405. BITMAP2    MOVE.L    (A5),MAGX
  1406.     MOVE.L    4(A5),MAGY
  1407.     MOVE.L    8(A5),OFFSETX
  1408.     MOVE.L    12(A5),OFFSETY
  1409.     MOVE.L    16(A5),INVERTX
  1410.     MOVE.L    20(A5),INVERTY
  1411.     RTS
  1412.  
  1413. ;----------------------------------------------------------------------
  1414. ;110
  1415. ; VIEW(ADDR, BPLCON0)
  1416. VIEW    BRA    DOVIEW        ;(PBRA)
  1417.  
  1418. ;----------------------------------------------------------------------
  1419. ;111
  1420. ; PALETTE(N, VAL)
  1421. PALETTE    BRA    DOPALET        ;(PBRA)
  1422.  
  1423. ;----------------------------------------------------------------------
  1424. ;112
  1425. ;Return the value of the extend (X) flag. This flag, effectively the
  1426. ; carry flag, is used for extended-precision arithmetic.
  1427. ; VAL:= CARRY(0)
  1428. ;
  1429. CARRY    MOVEQ    #0,D0        ;Clear high bytes
  1430.     ADDX.B    D0,D0        ;Add the extend (carry) value (0 or 1)
  1431.     RTS
  1432.  
  1433. ;----------------------------------------------------------------------
  1434. ;113
  1435. ;Return the value of the word at the given address.
  1436. ; WORD:= PEEK_W(ADDR)
  1437. ;
  1438. PEEK_W    MOVEA.L    (A5),A6        ;Get the address
  1439.     MOVEQ    #0,D0        ;Clear high word
  1440.     MOVE.W    (A6),D0        ;Return the word in D0
  1441.     RTS
  1442.  
  1443. ;----------------------------------------------------------------------
  1444. ;114
  1445. ;Store the word at the given address.
  1446. ; POKE_W(ADDR,WORD)
  1447. ;
  1448. POKE_W    MOVEA.L    (A5),A6        ;Get the address
  1449.     MOVE.W    6(A5),(A6)    ;Store the word
  1450.     RTS
  1451.  
  1452. ;----------------------------------------------------------------------
  1453. ;115
  1454. ;Return the value of the long at the given address.
  1455. ; LONG:= PEEK_L(ADDR)
  1456. ;
  1457. PEEK_L    MOVEA.L    (A5),A6        ;Get the address
  1458.     MOVE.L    (A6),D0        ;Return the long in D0
  1459.     RTS
  1460.  
  1461. ;----------------------------------------------------------------------
  1462. ;116
  1463. ;Store the long word at the given address.
  1464. ; POKE_L(ADDR,LONG)
  1465. ;
  1466. POKE_L    MOVEA.L    (A5),A6        ;Get the address
  1467.     MOVE.L    4(A5),(A6)    ;Store the long
  1468.     RTS
  1469.  
  1470. ;----------------------------------------------------------------------
  1471. ;117
  1472. ;Swap the high and low words in the value and return it.
  1473. ; VAL:= SWAP_W(VAL)
  1474. ;
  1475. SWAP_W    MOVE.L    (A5),D0        ;Get the value
  1476.     SWAP    D0
  1477.     RTS
  1478.  
  1479. ;----------------------------------------------------------------------
  1480. ;118
  1481. ;Sign-extend the 16-bit value and return it.
  1482. ; VAL:= EXT_L(VAL)
  1483. ;
  1484. EXT_L    MOVE.W    2(A5),D0
  1485.     EXT.L    D0
  1486.     RTS
  1487.  
  1488. ;----------------------------------------------------------------------
  1489. ;119
  1490. ;Move cursor on the second terminal (device #1) to column X, line Y.
  1491. ; Upper left corner is X,Y = 0,0.
  1492. ; CURSOR1(X,Y)
  1493. ; A6 is destroyed.
  1494. ;
  1495. CURSOR1    MOVE.B    #1,DEVICE    ;Set to device number 1
  1496.  
  1497.     MOVE.B    3(A5),D0    ;Get X position
  1498.     ROL.W    #8,D0        ;Put it into high byte of D0
  1499.     MOVE.B    7(A5),D0    ;Get Y position into low byte
  1500.  
  1501.     MOVEA.W    #28,A6        ;Set function code = "position cursor"
  1502.     JMP    VDEVHAN        ;(PJMP) do I/O
  1503.  
  1504. ;-----------------------------------------------------------------------
  1505. ;120
  1506. ;Set the display attributes for the second terminal (device #1)
  1507. ; BUTES1($1);
  1508. ;The bits in the argument set the attributes as follows:
  1509. ;    0 - bold (not dim)
  1510. ;    1 - underline
  1511. ;    2 - inverse video
  1512. ;    3 - flashing
  1513. ;
  1514. ;WARNING: The Wyse terminal is severely brain-damaged, and it insists on
  1515. ; inserting a space character whenever attributes are changed.
  1516. ;
  1517. BUTES1    MOVE.L    (A5),D0        ;Get argument
  1518.     MOVE.B    #1,DEVICE    ;Set to device # 1
  1519.     MOVEA.W    #48,A6        ;Set function code for "butes"
  1520.     JMP    VDEVHAN        ;(PJMP) go do it
  1521.  
  1522. ;-----------------------------------------------------------------------
  1523. ;121
  1524. ;Turn the cursor indicator on or off for the second terminal (device #1)
  1525. ; SHOCUR1('TRUE');
  1526. ;
  1527. SHOCUR1    MOVE.L    (A5),D0        ;Get boolean argument
  1528.     MOVE.B    #1,DEVICE    ;Set to device # 1
  1529.     MOVEA.W    #44,A6        ;Set function code for cursor control
  1530.     JMP    VDEVHAN        ;(PJMP) go do it
  1531.  
  1532. ;-----------------------------------------------------------------------
  1533. ;122
  1534. ;Return the address of the information array for a device
  1535. ; ADDR:= DEVINFO(DEV)
  1536. ;
  1537. DEVINFO    MOVE.B    3(A5),DEVICE    ;Get the device number
  1538.     MOVEA.W    #20,A6        ;Set function code for "getinfo"
  1539.     JMP    VDEVHAN        ;(PJMP) go do it
  1540.  
  1541. ;-----------------------------------------------------------------------
  1542. ;123
  1543. ;Return the address of the information array for a unit
  1544. ; ADDR:= UNTINFO(UNIT)
  1545. ;
  1546. UNTINFO    MOVE.B    3(A5),UNIT    ;Get the unit number
  1547.     MOVEA.W    #20,A6        ;Set function code for "getinfo"
  1548.     JMP    VUNTHAN        ;(PJMP) go do it
  1549.  
  1550. ;-----------------------------------------------------------------------
  1551. ;124
  1552. ;Set the display attributes for device 0
  1553. ; BUTES($1);
  1554. ;The bits in the argument set the attributes as follows:
  1555. ;    0 - bold (not dim)
  1556. ;    1 - underline
  1557. ;    2 - inverse video
  1558. ;    3 - flashing
  1559. ;
  1560. ;WARNING: The Wyse terminal is severely brain-damaged, and it insists on
  1561. ; inserting a space character whenever attributes are changed.
  1562. ;
  1563. BUTES    MOVE.L    (A5),D0        ;Get argument
  1564.     MOVE.B    #0,DEVICE    ;Set to device # 0
  1565.     MOVEA.W    #48,A6        ;Set function code for "butes"
  1566.     JMP    VDEVHAN        ;(PJMP) go do it
  1567.  
  1568. ;-----------------------------------------------------------------------
  1569. ;125
  1570. ;Wait for and then return the value of a key struck on
  1571. ; the keyboard
  1572. ; I:= GETKEY;
  1573. ;
  1574. GETKEY    MOVE.B    #1,DEVICE    ;Set to device # 1
  1575.     MOVEA.W    #36,A6        ;Set function code for "getkey"
  1576.     JMP    VDEVHAN        ;(PJMP) return with value in D0
  1577.  
  1578. ;-----------------------------------------------------------------------
  1579. ;126
  1580. ;Determine if a key (on the keyboard) has been struck
  1581. ; I:= KEYHIT;
  1582. ;
  1583. KEYHIT    MOVE.B    #1,DEVICE    ;Set to device # 1
  1584.     MOVEA.W    #40,A6        ;Set function code
  1585.     JMP    VDEVHAN        ;(PJMP) return with boolean in D0
  1586.  
  1587. ;-----------------------------------------------------------------------
  1588. ;127
  1589. ;Turn the cursor indicator on or off for device 0
  1590. ; SHOCUR('TRUE');
  1591. ;
  1592. SHOCUR    MOVE.L    (A5),D0        ;Get boolean argument
  1593.     MOVE.B    #0,DEVICE    ;Set to device # 0
  1594.     MOVEA.W    #44,A6        ;Set function code for cursor control
  1595.     JMP    VDEVHAN        ;(PJMP) go do it
  1596.  
  1597. ;=======================================================================
  1598. ;SUBROUTINES:
  1599. ;-----------------------------------------------------------------------
  1600. ;Input ASCII digits and convert them to a signed, decimal, 32-bit value
  1601. ; which is returned in D0.
  1602. ;    D0 = I/O
  1603. ;    D1 = Working register (contains number to be converted)
  1604. ;    D2 = Flag: a numeric character has been entered
  1605. ;    D3 = 10 multiplier
  1606. ;    D4 = Flag: a minus sign was entered, i.e. the number is negative
  1607. ;
  1608. INTI    MOVEM.L    D1-D4,-(SP)    ;Save registers
  1609.  
  1610. II00    MOVEQ    #0,D1        ;NUM:=0;
  1611.     CLR.B    D2        ;NUMFLG:=false
  1612.     CLR.B    D4        ;SIGN:=false
  1613.     MOVEQ    #10,D3
  1614.  
  1615.     BSR    BYTEIN        ;Get byte
  1616.     CMPI.B    #'-',D0        ;if D0 = ^- then SIGN := true
  1617.     BNE.S    II30
  1618.     MOVEQ    #TRUE,D4
  1619. ;                ;loop begin
  1620. II20    BSR    BYTEIN        ;Get byte
  1621. II30    CMPI.B    #'0',D0        ;  if D0<^0 ! D0>^9 then quit
  1622.     BLO.S    II50
  1623.     CMPI.B    #'9',D0
  1624.     BHI.S    II50
  1625.     MOVEQ    #TRUE,D2    ;  NUMFLG:=true
  1626.  
  1627.     MOVE.L    D1,D3        ;  NUM:= NUM*10 + (D0-^0)
  1628.     LSL.L    #2,D1        ;    *4
  1629.     ADD.L    D3,D1        ;    +1
  1630.     LSL.L    #1,D1        ;    *2
  1631.     SUBI.B    #'0',D0
  1632.     ADD.L    D0,D1
  1633.     BRA.S    II20        ;  end
  1634.  
  1635. II50    TST.B    D2        ;if NUMFLG then quit
  1636.     BEQ.S    II00
  1637.     TST.B    D4        ;if SIGN then NUM:= -NUM
  1638.     BEQ.S    II60
  1639.     NEG.L    D1
  1640. II60    MOVE.L    D1,D0        ;return NUM
  1641.  
  1642.     MOVEM.L    (SP)+,D1-D4    ;Restore registers
  1643.     RTS
  1644.  
  1645. ;-----------------------------------------------------------------------
  1646. ;Convert the signed, 32-bit value in D0 to decimal ASCII and output the
  1647. ; characters to DEVICE.
  1648. ;    D0 = I/O and subtract counter
  1649. ;    D1 = Working register (contains number to be converted)
  1650. ;    D2 = Flag used to suppress leading zeros (suppress if false)
  1651. ;    D3 = Power-of-ten (loop) counter
  1652. ;    D4 = Power of ten
  1653. ;    A0 = Pointer to power-of-ten table
  1654. ;
  1655. INTO    MOVEM.L    D0-D4/A0/A6,-(SP)    ;Save registers
  1656.     MOVEA.W    #12,A6        ;Set the function code = CHOUT
  1657.  
  1658.     MOVE.L    D0,D1        ;Put number into the working register
  1659.     BPL.S    INTO10        ;Branch if it is positive
  1660.     NEG.L    D1        ;Otherwise make it positive
  1661.     MOVEQ    #'-',D0        ;Output the minus sign
  1662.     JSR    VDEVHAN        ;Output D0
  1663.  
  1664.                 ;Initialize:
  1665. INTO10    MOVEQ    #FALSE,D2    ; flag used to suppress leading zeros
  1666.     MOVEQ    #8,D3        ; loop counter (8 down through 0)
  1667.     LEA    TENTBL-@-2(PC),A0 ; pointer to power-of-ten table
  1668.  
  1669. INTO20    MOVE.L    (A0)+,D4    ;Get a power of ten
  1670.     MOVEQ    #9,D0        ;Init loop counter (9-0)
  1671. INTO30    SUB.L    D4,D1        ;Repeatedly subtract a power of ten
  1672.     DBMI    D0,INTO30    ; until it goes negative
  1673.     ADD.L    D4,D1        ;Restore to positive value
  1674.  
  1675.     NEG.B    D0        ;This digit = 9 - D0
  1676.     ADD.B    #9,D0
  1677.     BNE.S    INTO40        ;Branch if digit is not zero
  1678.     TST.B    D2        ;Are we suppressing leading zeros?
  1679.     BEQ.S    INTO50        ;Branch if we are (i.e. flag = false)
  1680. INTO40    MOVEQ    #TRUE,D2    ;Turn leading zero suppression off
  1681.     ADD.B    #'0',D0        ;Convert digit to ASCII
  1682.     JSR    VDEVHAN        ;Output it
  1683. INTO50    DBF    D3,INTO20    ;Repeat for powers 1,000,000,000 down
  1684.                 ; thru 10;
  1685.     MOVE.B    D1,D0        ;Output the one's digit regardless of
  1686.     ADD.B    #'0',D0        ; the leading zero suppression flag
  1687.     JSR    VDEVHAN
  1688.  
  1689.     MOVEM.L    (SP)+,D0-D4/A0/A6    ;Restore registers
  1690.     RTS
  1691.  
  1692. ;Power-of-ten table:
  1693. TENTBL    DC.L    1000000000    ;1G
  1694.     DC.L    100000000
  1695.     DC.L    10000000
  1696.     DC.L    1000000        ;1M
  1697.     DC.L    100000
  1698.     DC.L    10000
  1699.     DC.L    1000        ;1K
  1700.     DC.L    100
  1701.     DC.L    10
  1702.  
  1703. ;-----------------------------------------------------------------------
  1704. ;Output a text string pointed to by A6.
  1705. ; The string is terminated with a binary zero.
  1706. ;
  1707. TEXTO    MOVEM.L    A0/A6,-(SP)    ;Save registers
  1708.     MOVEA.L    A6,A0        ;Get string address
  1709.  
  1710.     MOVEA.W    #12,A6        ;Set the function code to CHOUT
  1711.     BRA.S    TXT20        ;Enter loop
  1712.  
  1713. TXT10    JSR    VDEVHAN        ;Output D0
  1714. TXT20    MOVE.B    (A0)+,D0    ;Get char from string
  1715.     BNE.S    TXT10        ;Loop until zero byte
  1716.  
  1717.     MOVEM.L    (SP)+,A0/A6    ;Restore registers
  1718.     RTS
  1719.  
  1720. ;-----------------------------------------------------------------------
  1721. ;Input hex ASCII digits from DEVICE and convert them to a 32-bit value
  1722. ; which is returned in D0.
  1723. ;    D0 = Digit
  1724. ;    D1 = Accumulated value
  1725. ;    D2 = Digit counter
  1726. ;
  1727. HEXI    MOVEM.L    D1-D2,-(SP)    ;Save registers
  1728.     MOVEQ    #0,D1        ;Clear result register
  1729.     MOVEQ    #7,D2        ;Init digit counter (7 down through 0)
  1730.  
  1731. HEXI00    BSR    BYTEIN        ;Get byte
  1732.     CMPI.B    #'0',D0        ;Is character in range 0 thru 9?
  1733.     BLO.S    HEXI40        ;Branch if not
  1734.     CMPI.B    #'9',D0
  1735.     BHI.S    HEXI20        ;(May be A-F)
  1736.     SUBI.B    #'0',D0        ;Convert ASCII to binary value
  1737.     BRA.S    HEXI30        ;Go combine with other digits
  1738.  
  1739. HEXI20    ANDI.B    #$DF,D0        ;Force to uppercase
  1740.     CMPI.B    #'A',D0        ;Is character in range A thru F?
  1741.     BLO.S    HEXI40        ;Branch if not
  1742.     CMPI.B    #'F',D0
  1743.     BHI.S    HEXI40
  1744.     SUBI.B    #'A'-10,D0    ;Convert ASCII to binary value
  1745.  
  1746. HEXI30    ASL.L    #4,D1        ;Multiply current value by 16
  1747.     ADD.B    D0,D1        ;Add new digit
  1748.     DBF    D2,HEXI00    ;Exit if we have 8 digits
  1749.  
  1750. HEXI40    CMPI.B    #7,D2        ;Did we find a valid hex digit?
  1751.     BEQ.S    HEXI00        ;Branch if not -- keep trying
  1752.  
  1753.     MOVE.L    D1,D0        ;Return the hex value in D0
  1754.     MOVEM.L    (SP)+,D1-D2    ;Restore registers
  1755.     RTS
  1756.  
  1757. ;-----------------------------------------------------------------------
  1758. ;Output D0 in ASCII hex (8 digits)
  1759. ;
  1760. HEXO    SWAP    D0        ;Get high word
  1761.     BSR.S    WRDOUT        ;Output it
  1762.     SWAP    D0        ;(PFALL) get low word back
  1763.  
  1764. ;-----------------------------------------------------------------------
  1765. ;Output D0 in ASCII hex (4 digits)
  1766. ;
  1767. WRDOUT    ROR.W    #8,D0        ;Move high byte down (and save low byte)
  1768.     BSR.S    BYTOUT        ;Output it
  1769.     ROR.W    #8,D0        ;(PFALL) get low byte
  1770.  
  1771. ;-----------------------------------------------------------------------
  1772. ;Output D0 in ASCII hex (2 digits)
  1773. ;
  1774. BYTOUT    ROR.B    #4,D0        ;Move high nybble down (save low nybble)
  1775.     BSR.S    NYBOUT        ;Output it
  1776.     ROR.B    #4,D0        ;(PFALL) get low nybble
  1777.  
  1778. ;-----------------------------------------------------------------------
  1779. ;Output D0 in ASCII hex (1 digit)
  1780. ;
  1781. NYBOUT    MOVEM.L    D0/A6,-(SP)    ;Save registers
  1782.     ANDI.B    #$0F,D0        ;Work with low nybble only
  1783.     CMPI.B    #10,D0
  1784.     BLO.S    NO10
  1785.     ADDQ.B    #7,D0
  1786. NO10    ADDI.B    #'0',D0        ;Convert to ASCII
  1787.     MOVEA.W    #12,A6        ;Set the function code = CHOUT
  1788.     JSR    VDEVHAN        ;Output D0
  1789.     MOVEM.L    (SP)+,D0/A6    ;Restore registers
  1790.     RTS
  1791.  
  1792. ;-----------------------------------------------------------------------
  1793. ;Input a byte from DEVICE and return it in D0.
  1794. ;
  1795. BYTEIN    TST.B    BACKFL        ;Re-read the last character?
  1796.     BEQ.S    BYIN20        ;Branch if not
  1797.     CLR.B    BACKFL        ;Clear backup flag
  1798.     MOVEQ    #0,D0
  1799.     MOVE.B    LASTCH,D0    ;Return the last character
  1800.     RTS
  1801.  
  1802. BYIN20    MOVE.L    A6,-(SP)    ;Save A6
  1803.     MOVEA.W    #8,A6        ;Set the function code = CHIN
  1804.     JSR    VDEVHAN        ;Do I/O
  1805.     MOVE.B    D0,LASTCH    ;Save in case we need to re-read it
  1806.     MOVEA.L    (SP)+,A6    ;Restore A6
  1807.     RTS
  1808.  
  1809. ;======================================================================
  1810. ;GRAPHICS ROUTINES
  1811. ;
  1812. CHIPREG    EQU    $DFF000        ;Base address of chip registers
  1813. ;Offsets to chip registers:
  1814. DMACONR    EQU    $02        ;DMA control (and blitter status) read
  1815. VPOSR    EQU    $04        ;Read vert. MSB and frame flop LOF
  1816. INTREQR    EQU    $1E        ;Interrupt request bits read
  1817. BLTCON0    EQU    $40        ;Blitter control register 0
  1818. BLTCON1    EQU    $42        ;Blitter control register 1
  1819. BLTAFWM    EQU    $44        ;Blitter first word mask for source A
  1820. BLTCPTH    EQU    $48        ;Blitter ptr to source C (high 3 bits)
  1821. BLTAPTH    EQU    $50        ;Blitter ptr to source A (high 3 bits)
  1822. BLTAPTL    EQU    $52        ;Blitter ptr to source A (low 15 bits)
  1823. BLTDPTH    EQU    $54        ;Blitter ptr to destn. D (high 3 bits)
  1824. BLTSIZE    EQU    $58        ;Blitter start and size (width, height)
  1825. BLTCMOD    EQU    $60        ;Blitter modulo for source C
  1826. BLTBMOD    EQU    $62        ;Blitter modulo for source B
  1827. BLTAMOD    EQU    $64        ;Blitter modulo for source A
  1828. BLTDMOD    EQU    $66        ;Blitter modulo for destn. D
  1829. BLTBDAT    EQU    $72        ;Blitter source B data register
  1830. BLTADAT    EQU    $74        ;Blitter source A data register
  1831. COP1LCH    EQU    $80        ;Copper 1st location reg (high 3 bits)
  1832. COP1LCL    EQU    $82        ;Copper 1st location reg (low 15 bits)
  1833. DIWSTRT    EQU    $8E        ;Display window start
  1834. DIWSTOP    EQU    $90        ;Display window stop
  1835. DDFSTRT    EQU    $92        ;Display bit plane data fetch start
  1836. DDFSTOP    EQU    $94        ;Display bit plane data fetch stop
  1837. DMACON    EQU    $96        ;DMA control write (clear or set)
  1838. INTENA    EQU    $9A        ;Interrupt enable bits (clear or set)
  1839. INTREQ    EQU    $9C        ;Interrupt request bits (clear or set)
  1840. BPL1PTH    EQU    $E0        ;Bit plane 1 pointer (high 3 bits)
  1841. BPLCON0    EQU    $100        ;Bit plane control register 0
  1842. BPLCON1    EQU    $102        ;Bit plane control register 1
  1843. BPLCON2    EQU    $104        ;Bit plane control register 2
  1844. BPL1MOD    EQU    $108        ;Bit plane modulo (odd planes)
  1845. BPL2MOD    EQU    $10A        ;Bit plane modulo (even planes)
  1846. COLOR00    EQU    $180        ;Color register 00
  1847. COLOR01    EQU    $182        ;Color register 01
  1848.  
  1849. ;----------------------------------------------------------------------
  1850. ;107
  1851. ;Wait for vertical blank on the video screen
  1852. ;
  1853. WAITVB    MOVE.W    #$0020,INTREQ+CHIPREG.L
  1854. WVB10    MOVE.W    INTREQR+CHIPREG.L,D0
  1855.     BTST    #5,D0
  1856.     BEQ.S    WVB10
  1857.     RTS
  1858.  
  1859. ;----------------------------------------------------------------------
  1860. ;Remap the X coordinate in D0.
  1861. ;
  1862. REMAPX    MOVE.W    D1,-(SP)    ;Save D1
  1863.  
  1864.     MOVE.W    MAGX+2,D1    ;Get the magnification factor
  1865.     BEQ.S    RMX20        ;Branch if no magnification
  1866.     BGE.S    RMX10        ;Branch if it's increasing in size
  1867.     NEG.W    D1        ;It's decreasing in size
  1868.     ASR.L    D1,D0
  1869.     BRA.S    RMX20
  1870. RMX10    ASL.L    D1,D0
  1871. RMX20
  1872.     ADD.L    OFFSETX,D0    ;Add offset
  1873.  
  1874.     TST.L    INVERTX        ;Is X increasing to the left?
  1875.     BEQ.S    RMX30        ;Branch if not
  1876.     NEG.L    D0        ;D0:= WIDTH - D0
  1877.     ADD.L    WIDTH,D0
  1878. RMX30
  1879.     MOVE.W    (SP)+,D1    ;Restore D1
  1880.     RTS            ;Return with remapped value in D0
  1881.  
  1882. ;----------------------------------------------------------------------
  1883. ;Remap the Y coordinate in D0.
  1884. ;
  1885. REMAPY    MOVE.W    D1,-(SP)    ;Save D1
  1886.  
  1887.     MOVE.W    MAGY+2,D1    ;Get the magnification factor
  1888.     BEQ.S    RMY20        ;Branch if no magnification
  1889.     BGE.S    RMY10        ;Branch if it's increasing in size
  1890.     NEG.W    D1        ;It's decreasing in size
  1891.     ASR.L    D1,D0
  1892.     BRA.S    RMY20
  1893. RMY10    ASL.L    D1,D0
  1894. RMY20
  1895.     ADD.L    OFFSETY,D0    ;Add offset
  1896.  
  1897.     TST.L    INVERTY        ;Is Y increasing upward?
  1898.     BEQ.S    RMY30        ;Branch if not
  1899.     NEG.L    D0        ;D0:= HEIGHT - D0
  1900.     ADD.L    HEIGHT,D0
  1901. RMY30
  1902.     MOVE.W    (SP)+,D1    ;Restore D1
  1903.     RTS            ;Return with remapped value in D0
  1904.  
  1905. ;----------------------------------------------------------------------
  1906. ;This sets up a copper list to display the bit map whos upper-left
  1907. ; corner is at ADDR. It sets the bit plane control register, BPLCON0,
  1908. ; directly, and from this the display's width, height, and depth are
  1909. ; determined. The bit map's WIDTH and HEIGHT are assumed to have been
  1910. ; set. (These are used to determine modulo and size when DEPTH is
  1911. ; greater than one.) ADDR should be an even address (RESERVE will
  1912. ; automatically do this.)
  1913. ;This routine handles the common displays, however it does not handle
  1914. ; dual playfields, or horizontal scrolling. These may be accomplished
  1915. ; by setting the chip registers directly.
  1916. ;
  1917. ;   VIEW(ADDR, BPLCON0)
  1918. ;   BPLCON0 bits:
  1919. ;    15 HIRES    11 HAM        07 --        03 LPEN
  1920. ;    14 BPU2        10 DBLPF    06 --        02 LACE
  1921. ;    13 BPU1        09 COLOR    05 --        01 ERSYNC
  1922. ;    12 BPU0        08 GAUD        04 --        00 --
  1923. ;
  1924. ; Register usage:
  1925. ;    D0 = BPLCON0 and scratch
  1926. ;    D1 = Size of each bit plane in bytes
  1927. ;    D2 = Modulo and depth of bit planes
  1928. ;    D3 = Display data fetch (DDF) and bit plane pointers (BPLxPT)
  1929. ;    D4 = View address (ADDR)
  1930. ;    A0 = Base address of chip registers (CHIPREG)
  1931. ;    A1 = Copper list pointer
  1932. ;    A2 = Start of even copper list
  1933. ;    A3 = Start of odd copper list (if interlaced display)
  1934. ;
  1935. ;
  1936. DOVIEW    MOVEM.L    D0-D4/A0-A3,-(SP)    ;Save registers
  1937.     LEA    CHIPREG.L,A0    ;Point A0 to base of chip registers
  1938.  
  1939.     MOVE.L    (A5),D4        ;Get view address (ADDR)
  1940.     MOVE.W    6(A5),D0    ;Get BPLCON0
  1941.     MOVE.W    D0,BPLCON0(A0)    ; and set it
  1942.  
  1943.     MOVE.W    WIDTH+2,D2    ;Set the modulo...
  1944.     LSR.W    #3,D2        ;Divide by 8 to convert bits to bytes
  1945.     MOVE.W    D2,D1        ;Save width in bytes for later
  1946.  
  1947.     SUB.W    #40,D2        ;Anticipate LOWRES mode
  1948.     MOVE.L    #$00D00038,D3    ;Set LOWRES DDF stop and start positions
  1949.     BTST    #15,D0        ;Is it HIRES mode?
  1950.     BEQ.S    VIEW10        ;Branch if not
  1951.     SUB.W    #40,D2        ;Account for another 40 bytes of width
  1952.     MOVE.L    #$00D4003C,D3    ;HIRES DDF stop and start positions
  1953. VIEW10
  1954.     BTST    #2,D0        ;Is interlace requested?
  1955.     BEQ.S    VIEW20        ;Branch if not
  1956.     ADD.W    D1,D2        ;Skip every other line of bit plane
  1957. VIEW20
  1958.     MOVE.W    D2,BPL1MOD(A0)    ;Set modulo
  1959.     MOVE.W    D2,BPL2MOD(A0)    ;Set unused modulo to known state
  1960.  
  1961.     MOVE.W    D3,DDFSTRT(A0)    ;Set display data fetch horz start posn
  1962.     SWAP    D3        ;Get stop position
  1963.     MOVE.W    D3,DDFSTOP(A0)    ; and set it
  1964.  
  1965.     MOVE.W    #$1781,DIWSTRT(A0) ;Set display window start and stop
  1966.     MOVE.W    #$07C1,DIWSTOP(A0) ; horizontal and vertical positions
  1967.  
  1968.     MOVEQ    #0,D2        ;(Warning: CLR.W does a read cycle)
  1969.     MOVE.W    D2,BPLCON1(A0)    ;Initialize these unused registers to
  1970.     MOVE.W    D2,BPLCON2(A0)    ; a known state
  1971.  
  1972.     MOVE.W    #$8380,DMACON(A0) ;Make sure bit plane and copper DMA
  1973.                 ; are on
  1974. ;Set up the copper list:
  1975.     MULU    HEIGHT+2,D1    ;D1 = size of each bit plane, in bytes
  1976.  
  1977.     MOVE.W    D0,D2        ;D2 = number of bit planes used (depth)
  1978.     ROL.W    #4,D2        ;Get BPU bits from BPLCON0
  1979.     AND.W    #0007,D2
  1980.  
  1981.     LEA    COPLST1,A1    ;Point A1 to first copper list area
  1982.     BTST    #0,COPFLAG    ;Is this list busy?
  1983.     BEQ.S    VIEW30        ;Branch if not
  1984.     LEA    COPLST2,A1    ;Point A1 to second copper list area
  1985. VIEW30    ADDQ.B    #1,COPFLAG    ;Flip busy flag
  1986.     MOVEA.L    A1,A2        ;Save (even) copper list address
  1987.     BSR.S    VIEW100        ;Set up copper list
  1988.  
  1989.     BTST    #2,D0        ;Is display interlaced?
  1990.     BEQ.S    VIEW80        ;Branch if not
  1991.  
  1992.     MOVE.W    #COP1LCL,D0    ;Set up call for odd copper list
  1993.     SWAP    D0
  1994.     MOVE.W    A1,D0        ;Get odd copper list address
  1995.     ADDQ.W    #8,D0        ;Past this and next instructions
  1996.     MOVE.L    D0,(A1)+
  1997.  
  1998.     MOVEQ    #$FFFFFFFE,D0    ;Terminate even copper list with
  1999.     MOVE.L    D0,(A1)+    ; wait-forever command
  2000.     MOVEA.L    A1,A3        ;Save address of odd copper list
  2001.  
  2002.     MOVE.L    WIDTH,D0    ;Point to second (odd) display line
  2003.     LSR.L    #3,D0        ;Divide by 8 to convert bits to bytes
  2004.     ADD.L    D0,D4
  2005.  
  2006.     BSR.S    VIEW100        ;Set up odd copper list
  2007.  
  2008.     MOVE.W    #COP1LCL,D0    ;Set up call to even copper list
  2009.     SWAP    D0
  2010.     MOVE.W    A2,D0        ;Get even copper list address
  2011.     MOVE.L    D0,(A1)+
  2012.  
  2013.     MOVEQ    #$FFFFFFFE,D0    ;Terminate with wait-forever command
  2014.     MOVE.L    D0,(A1)+
  2015.  
  2016.     MOVE.W    VPOSR(A0),D0    ;Is current frame long (even)?
  2017.     BPL.S    VIEW50        ;Branch if not -- branch if odd frame
  2018.     EXG    A2,A3        ;Current frame is even, next will be odd
  2019. VIEW50    MOVE.L    A2,COP1LCH(A0)
  2020.  
  2021.     MOVE.W    VPOSR(A0),D1    ;Did vertical blank occur during last
  2022.     EOR.W    D1,D0        ; few instructions (LOF change)?
  2023.     BPL.S    VIEW90        ;Branch if not
  2024.     MOVE.L    A3,COP1LCH(A0)    ;Current frame is odd, next will be even
  2025.     BRA.S    VIEW90
  2026.  
  2027. ;Here if non-interlaced display
  2028. VIEW80    MOVEQ    #$FFFFFFFE,D0    ;Terminate with wait-forever command
  2029.     MOVE.L    D0,(A1)+
  2030.  
  2031. ;This new copper list will be used at the next vertical sync. All copper
  2032. ; lists must be in the same 64K "page" to prevent a possible big glitch.
  2033.     MOVE.L    A2,COP1LCH(A0)
  2034.  
  2035. VIEW90    MOVEM.L    (SP)+,D0-D4/A0-A3    ;Restore registers
  2036.     RTS
  2037.  
  2038. ;----------------------------------------------------------------------
  2039. ;Routine to set up a copper list.
  2040. ;Inputs:
  2041. ;    D1 = Bit plane size (bytes)
  2042. ;    D2 = Number of bit planes (depth)
  2043. ;    D4 = View address (ADDR)
  2044. ;    A1 = Copper list address pointer
  2045. ;
  2046. ;
  2047. VIEW100    MOVEM.L    D2/D4,-(SP)    ;Save some registers
  2048.  
  2049.     MOVE.W    #BPL1PTH,D3    ;Set to first bit-plane pointer register
  2050.     BRA.S    VIEW130        ;Enter loop checking for zero (be safe)
  2051.  
  2052. VIEW120    MOVE.W    D3,(A1)+    ;Put pointer register into copper list
  2053.     ADDQ.W    #2,D3        ;Next pointer register
  2054.     SWAP    D4        ;Get the high word of view address
  2055.     MOVE.W    D4,(A1)+    ;Put it into copper list
  2056.     SWAP    D4
  2057.  
  2058.     MOVE.W    D3,(A1)+    ;Put pointer register into copper list
  2059.     ADDQ.W    #2,D3        ;Next pointer register
  2060.     MOVE.W    D4,(A1)+    ;Put low word of view address into list
  2061.  
  2062.     ADD.L    D1,D4        ;Add bit-plane size to view address
  2063.  
  2064. VIEW130    DBF    D2,VIEW120    ;Loop for all bit planes
  2065.  
  2066.     MOVEM.L    (SP)+,D2/D4    ;Restore some registers
  2067.     RTS
  2068.  
  2069. ;----------------------------------------------------------------------
  2070. ;Set color register N to value VAL.
  2071. ; PALETTE(N, VAL)
  2072. ;
  2073. DOPALET    MOVEQ    #0,D0        ;Get the color register number
  2074.     MOVE.B    3(A5),D0    ; (limit to 256 color regs for safety)
  2075.     ADD.W    D0,D0        ;Double for word entries
  2076.     ADD.W    #COLOR00,D0    ;Add base address of color registers
  2077.     LEA    CHIPREG.L,A6
  2078.     MOVE.W    6(A5),0(A6,D0.W) ;Set color register's value
  2079.     RTS
  2080.  
  2081. ;----------------------------------------------------------------------
  2082. ;Routine to clear the current bit map by setting it to the color
  2083. ; defined by color register 0. It also moves X0,Y0 to 0,0.
  2084. ; The blitter uses every other even memory cycle to clear memory. This
  2085. ; allows the 68000 to run simultaneously. Maximum efficiency is achieved
  2086. ; if the 68000 doesn't immediately call LINE or POINT since these
  2087. ; operations will require waiting for the blitter. This will clear a
  2088. ; 640x480x1 bitmap in approximately 1/75th of a second.
  2089. ;
  2090. ;This simply clears the number of words equal to WIDTH/16 *HEIGHT *DEPTH
  2091. ; The blitter can clear a maximum of 128K bytes per pass.
  2092. ;
  2093. DOCLEAR    MOVEM.L    D0/D1/A0,-(SP)    ;Save registers
  2094.  
  2095.     LEA    CHIPREG.L,A0    ;Set register base (it's efficient)
  2096.     MOVE.W    #$8640,DMACON(A0) ;Enable blitter DMA and be nasty
  2097.  
  2098.     MOVE.W    WIDTH+2,D1    ;No. of words = WIDTH/16 *DEPTH *HEIGHT
  2099.     MULU    DEPTH+2,D1    ;(This product must not exceed 65535)
  2100.     MULU    HEIGHT+2,D1
  2101.     LSR.L    #4,D1        ;Divide by 16 to get number of words
  2102.  
  2103.     BSR    WAITBLT        ;Wait for blitter not busy
  2104.  
  2105.     MOVE.L    RASTER,BLTDPTH(A0)    ;Point to location to be cleared
  2106.     MOVEQ    #0,D0            ;(Warning: CLR.W does a read)
  2107.     MOVE.W    D0,BLTDMOD(A0)        ;Modulo = 0
  2108.     MOVE.W    #$0100,BLTCON0(A0)    ;Use destination D only
  2109.     MOVE.W    D0,BLTCON1(A0)
  2110.  
  2111.     MOVE.W    D1,D0        ;Is there a small chunk <$1000 to clear?
  2112.     BEQ.S    CLR25        ;Branch if not
  2113.     ANDI.W    #$003F,D0    ;Is there a chunk <64 words to clear?
  2114.     BEQ.S    CLR22        ;Branch if not
  2115.     ORI.W    #$0040,D0    ;Clear chunk with height =1 & width =D0
  2116.     MOVE.W    D0,BLTSIZE(A0)
  2117. CLR22
  2118.     ANDI.W    #$FFC0,D1    ;Is $40 <= chunk <$10000?
  2119.     BEQ.S    CLR25        ;Branch if not
  2120.     BSR    WAITBLT
  2121.     MOVE.W    D1,BLTSIZE(A0)    ;Clear chunk: hight=D1/64, width=64 words
  2122. CLR25
  2123.     SWAP    D1        ;D1.W:= number of $10000 chunks to clear
  2124.     BRA.S    CLR50        ;Enter loop checking for zero chunks
  2125. CLR30
  2126.     BSR    WAITBLT        ;Wait for blitter not busy
  2127.     MOVE.W    #0,BLTSIZE(A0)    ;Clear 128K bytes, and advance BLTDPTH
  2128.                 ; (128K bytes = $10000 words)
  2129. CLR50    DBF    D1,CLR30    ;Loop for next $10000 chunk
  2130.  
  2131. CLR60    MOVEQ    #0,D0        ;MOVE(0,0)
  2132.     MOVE.L    D0,X0
  2133.     MOVE.L    D0,Y0
  2134.  
  2135.     MOVEM.L    (SP)+,D0/D1/A0    ;Restore registers
  2136.     RTS
  2137.  
  2138. ;----------------------------------------------------------------------
  2139. ;Routine to plot a point at X0,Y0 of the given COLOR.
  2140. ; The upper-left corner is coordinate 0,0, and the positive Y direction
  2141. ; is down (this might have been remapped by BITMAP2).
  2142. ;
  2143. DOPOINT    MOVEM.L    D0-D3/A6,-(SP)    ;Save registers
  2144.  
  2145.     MOVE.L    X0,D1        ;Clip points outside bit map
  2146.     BMI.S    DOPT90
  2147.     CMP.L    WIDTH,D1
  2148.     BGE.S    DOPT90
  2149.  
  2150.     MOVE.L    Y0,D0        ;BYTE = (X0 + Y0*WIDTH) /8 + RASTER
  2151.     BMI.S    DOPT90        ;D0 =
  2152.     CMP.L    HEIGHT,D0
  2153.     BGE.S    DOPT90
  2154.  
  2155.     MULU    WIDTH+2,D0    ; * Y0
  2156.     ADD.L    D1,D0        ; + X0
  2157.     LSR.L    #3,D0        ; / 8
  2158.  
  2159.     MOVEQ    #7,D1        ;BIT = 7 - REM(X0/8)
  2160.     SUB.B    X0+3,D1
  2161.  
  2162.     MOVE.W    WIDTH+2,D3    ;D3 = SIZE = WIDTH *HEIGHT
  2163.     MULU    HEIGHT+2,D3
  2164.     LSR.L    #3,D3        ;Divide by 8 to get size in bytes
  2165.  
  2166.     LEA    CHIPREG.L,A6    ;Set register base (it's efficient)
  2167. DOPT05    MOVE.W    DMACONR(A6),D2    ;Wait for blitter not busy, because it
  2168.     BTST    #14,D2        ; might be doing a CLEAR
  2169.     BNE.S    DOPT05
  2170.  
  2171.     MOVEA.L    RASTER,A6
  2172.  
  2173.     MOVEQ    #0,D2
  2174. DOPT10    BTST    #0,MODES
  2175.     BNE.S    DOPT40        ;Branch if complement mode
  2176.  
  2177.     BTST    D2,COLOR+3    ;Plot the point in the current screen
  2178.     BEQ.S    DOPT20        ; if the corresponding COLOR bit is set
  2179.     BSET    D1,0(A6,D0.L)    ;(D1 is modulo 8)
  2180.     BRA.S    DOPT30
  2181. DOPT20    BTST    #1,MODES
  2182.     BNE.S    DOPT50        ;Branch if fast mode
  2183.     BCLR    D1,0(A6,D0.L)    ;(D1 is modulo 8)
  2184. DOPT30    BRA.S    DOPT50
  2185.  
  2186. DOPT40    BCHG    D1,0(A6,D0.L)    ;(D1 is modulo 8)
  2187.  
  2188. DOPT50    ADDA.L    D3,A6        ;Next bit plane -- add SIZE to ADDR
  2189.     ADDQ.W    #1,D2        ;(DBF will not work)
  2190.     CMP.W    DEPTH+2,D2
  2191.     BLT.S    DOPT10
  2192.  
  2193. DOPT90    MOVEM.L    (SP)+,D0-D3/A6    ;Restore registers
  2194.     RTS
  2195.  
  2196. ;----------------------------------------------------------------------
  2197. ;Routine to draw a line from X0,Y0 to X1,Y1.
  2198. ; This routine first checks to see if the line falls outside the RASTER
  2199. ; dimensions. If it does, the line is clipped and only the portion
  2200. ; within the RASTER is drawn. The blitter in line-drawing mode, which
  2201. ; plots a point every 2.24 microseconds.
  2202. ; The upper-left corner is coordinate 0,0, and the positive Y direction
  2203. ; is down (this might have been remapped by BITMAP2).
  2204. ;
  2205. ; Register usage (for clip, and for line):
  2206. ;    D0 = Scratch    Scratch
  2207. ;    D1 = Scratch    BLTSIZE
  2208. ;    D2 = Code 0    Bit plane
  2209. ;    D3 = Code 1    BLTCON0
  2210. ;    D4 = X0        RASTER size in bytes
  2211. ;    D5 = Y0        BLTCPTH & BLTDPTH, address of start of line
  2212. ;    D6 = X1        BLTAPTL
  2213. ;    D7 = Y1        BLTCON1
  2214. ;
  2215. ;
  2216. DOLINE    MOVEM.L    D0-D7/A0,-(SP)    ;Save registers
  2217.  
  2218. ;Clip lines to the RASTER dimensions:
  2219.     MOVE.L    X0,D4        ;Load registers with line end points
  2220.     MOVE.L    Y0,D5
  2221.     MOVE.L    Y1,D7
  2222.  
  2223.     MOVEQ    #0,D3        ;Initialize flag bits
  2224.     MOVE.L    X1,D6
  2225.     SMI    D3        ;Code 1 (X1LO, X1HI, Y1LO, Y1HI)
  2226.     ADD.W    D3,D3        ;D3 Bits:  10    9     8     7-0
  2227.     CMP.L    WIDTH,D6
  2228.     SGE    D3
  2229.     ADD.W    D3,D3        ;Shift left
  2230.     TST.L    D7
  2231.     SMI    D3
  2232.     ADD.W    D3,D3
  2233.     CMP.L    HEIGHT,D7
  2234.     SGE    D3
  2235.  
  2236.     MOVEQ    #0,D2        ;Initialize flag bits
  2237.     TST.L    D4        ;Code 0 (X0LO, X0HI, Y0LO, Y0HI)
  2238.     SMI    D2        ;D2 Bits:  10    9     8     7-0
  2239.     ADD.W    D2,D2
  2240.     CMP.L    WIDTH,D4
  2241.     SGE    D2
  2242.     ADD.W    D2,D2
  2243.     TST.L    D5
  2244.     SMI    D2
  2245.     ADD.W    D2,D2
  2246.     CMP.L    HEIGHT,D5
  2247.     SGE    D2
  2248.  
  2249.     MOVE.W    D2,D0        ;Is the line completely inside of the
  2250.     OR.W    D3,D0        ; RASTER area?
  2251.     BEQ    LINE00        ;Branch if it is -- draw it
  2252.  
  2253.     MOVE.W    D2,D0        ;Is the line completely outside of the
  2254.     AND.W    D3,D0        ; RASTER area?
  2255.     BNE    LINE90        ;Branch if it is -- forget it
  2256.  
  2257. ;Handle points outside 16-bit arithmetic range by dividing both X and Y
  2258. ; by 2 until they are within range.
  2259.     MOVE.L    D4,D1        ;Get X0 into D1
  2260.     BPL.S    CLIP010        ;Work with positive value
  2261.     NEG.L    D1
  2262. CLIP010
  2263.     MOVE.L    D5,D2        ;Get Y0 into D2
  2264.     BPL.S    CLIP020        ;Work with positive value
  2265.     NEG.L    D2
  2266. CLIP020
  2267.     MOVE.L    #$4000,D0    ;Are X0 and Y0 within 16 bit range?
  2268.     CMP.L    D0,D1
  2269.     BHS.S    CLIP030        ;Branch if not (beware of $80000000)
  2270.     CMP.L    D0,D2
  2271.     BLO.S    CLIP060        ;Branch if they are
  2272. CLIP030
  2273.     MOVEQ    #31,D0        ;Scan for most significant bit
  2274. CLIP040    BTST    D0,D1        ;(Some bit from 14 up to 31 is set)
  2275.     BNE.S    CLIP050        ;Exit loop when found
  2276.     BTST    D0,D2
  2277.     DBNE    D0,CLIP040
  2278. CLIP050
  2279.     SUB.B    #13,D0        ;Bits 0-13 are within range
  2280.     ASR.L    D0,D4        ;Divide X0 and Y0 by 2 until they are
  2281.     ASR.L    D0,D5        ; within 16-bit arithmetic range
  2282. CLIP060
  2283.     MOVE.L    D6,D1        ;Repeat for X1, Y1...
  2284.     BPL.S    CLIP110
  2285.     NEG.L    D1
  2286. CLIP110
  2287.     MOVE.L    D7,D2
  2288.     BPL.S    CLIP120
  2289.     NEG.L    D2
  2290. CLIP120
  2291.     MOVE.L    #$4000,D0
  2292.     CMP.L    D0,D1
  2293.     BHS.S    CLIP130
  2294.     CMP.L    D0,D2
  2295.     BLO.S    CLIP160
  2296. CLIP130
  2297.     MOVEQ    #31,D0
  2298. CLIP140    BTST    D0,D1
  2299.     BNE.S    CLIP150
  2300.     BTST    D0,D2
  2301.     DBNE    D0,CLIP140
  2302. CLIP150
  2303.     SUB.B    #13,D0
  2304.     ASR.L    D0,D6
  2305.     ASR.L    D0,D7
  2306. CLIP160
  2307. ;At this point all points are within 16-bit arithmetic range.
  2308.     MOVEQ    #0,D3        ;Initialize flag bits
  2309.     TST.W    D6        ;Code 0 (X0LO, X0HI, Y0LO, Y0HI)
  2310.     SMI    D3        ;D3 Bits:  10    9     8     7-0
  2311.     ADD.W    D3,D3
  2312.     CMP.W    WIDTH+2,D6
  2313.     SGE    D3
  2314.     ADD.W    D3,D3
  2315.     TST.W    D7
  2316.     SMI    D3
  2317.     ADD.W    D3,D3
  2318.     CMP.W    HEIGHT+2,D7
  2319.     SGE    D3
  2320.  
  2321. CLIP200    MOVEQ    #0,D2        ;Initialize flag bits
  2322.     TST.W    D4        ;Code 0 (X0LO, X0HI, Y0LO, Y0HI)
  2323.     SMI    D2        ;D2 Bits:  10    9     8     7-0
  2324.     ADD.W    D2,D2
  2325.     CMP.W    WIDTH+2,D4
  2326.     SGE    D2
  2327.     ADD.W    D2,D2
  2328.     TST.W    D5
  2329.     SMI    D2
  2330.     ADD.W    D2,D2
  2331.     CMP.W    HEIGHT+2,D5
  2332.     SGE    D2
  2333.  
  2334.     MOVE.W    D2,D0        ;Is the line completely inside of the
  2335.     OR.W    D3,D0        ; RASTER area?
  2336.     BEQ    LINE00        ;Branch if it is -- draw it
  2337.  
  2338.     MOVE.W    D2,D0        ;Is the line completely outside of the
  2339.     AND.W    D3,D0        ; RASTER area?
  2340.     BNE    LINE90        ;Branch if it is -- forget it
  2341.  
  2342.     TST.W    D2        ;Make sure that point X0,Y0 is outside
  2343.     BNE.S    CLIP210        ; the RASTER area
  2344.     EXG    D4,D6        ;Swap points
  2345.     EXG    D5,D7
  2346.     EXG    D2,D3        ;Swap codes
  2347. CLIP210
  2348.     TST.B    D2        ;Is point X0,Y0 beyond the bottom?
  2349.     BEQ.S    CLIP220        ;Branch if it is not
  2350.     SUB.W    D6,D4        ;Clip line at bottom edge of RASTER
  2351.     MOVE.W    HEIGHT+2,D1    ;X0:= X1 + (X0 - X1) * (HEIGHT-1 - Y1) /
  2352.     SUBQ.W    #1,D1        ;    (Y0 - Y1)
  2353.     MOVE.W    D1,D2        ;D4:= D6 + (D4 - D6) * (HEIGHT-1 - D7) /
  2354.     SUB.W    D7,D1        ;    (D5 - D7)
  2355.     MULS    D1,D4
  2356.     SUB.W    D7,D5
  2357.     DIVS    D5,D4
  2358.     ADD.W    D6,D4
  2359.     MOVE.W    D2,D5        ;Y0:= HEIGHT -1
  2360.     BRA.S    CLIP200
  2361. CLIP220
  2362.     BTST    #8,D2        ;Is point X0,Y0 above the top?
  2363.     BEQ.S    CLIP230        ;Branch if it is not
  2364.     SUB.W    D6,D4        ;Clip line at top edge of RASTER
  2365.     MULS    D7,D4        ;X0:= X1 + (X0 - X1) * Y1 / (Y1 - Y0)
  2366.     MOVE.W    D7,D1        ;D4:= D6 + (D4 - D6) * D7 / (D7 - D5)
  2367.     SUB.W    D5,D1
  2368.     DIVS    D1,D4
  2369.     ADD.W    D6,D4
  2370.     CLR.W    D5        ;Y0:= 0
  2371.     BRA.S    CLIP200
  2372. CLIP230
  2373.     BTST    #9,D2        ;Is point X0,Y0 beyond the right edge?
  2374.     BEQ.S    CLIP240        ;Branch if it is not
  2375.     SUB.W    D7,D5        ;Clip line at right edge of RASTER
  2376.     MOVE.W    WIDTH+2,D1    ;Y0:= Y1 + (Y0 - Y1) * (WIDTH-1 - X1) /
  2377.     SUBQ.W    #1,D1        ;    (X0 - X1)
  2378.     MOVE.W    D1,D2        ;D5:= D7 + (D5 - D7) * (WIDTH-1 - D6) /
  2379.     SUB.W    D6,D1        ;    (D4 - D6)
  2380.     MULS    D1,D5
  2381.     SUB.W    D6,D4
  2382.     DIVS    D4,D5
  2383.     ADD.W    D7,D5
  2384.     MOVE.W    D2,D4        ;X0:= WIDTH -1
  2385.     BRA    CLIP200
  2386. CLIP240                ;Pt. X0,Y0 must be left of the left edge
  2387.     SUB.W    D7,D5        ;Clip line at left edge of RASTER
  2388.     MULS    D6,D5        ;Y0:= Y1 + (Y0 - Y1) * X1 / (X1 - X0)
  2389.     MOVE.W    D6,D1        ;D5:= D7 + (D5 - D7) * D6 / (D6 - D4)
  2390.     SUB.W    D4,D1
  2391.     DIVS    D1,D5
  2392.     ADD.W    D7,D5
  2393.     CLR.W    D4        ;X0:= 0
  2394.     BRA    CLIP200        ;Loop a maximum of four times
  2395.  
  2396. ;Draw the line:
  2397. LINE00    LEA    CHIPREG.L,A0    ;Set register base (it's efficient)
  2398.     MOVE.W    #$8640,DMACON(A0) ;Enable blitter DMA and be nasty
  2399.     BSR    WAITBLT        ;Wait for blitter not busy
  2400.  
  2401.     MOVEQ    #0,D0        ;Initialize octant value
  2402.     MOVE.W    D6,D1        ;Calculate delta X
  2403.     SUB.W    D4,D1
  2404.     BPL.S    LINE10        ;Branch if positive
  2405.     NEG.W    D1        ;Make it positive
  2406.     BSET    #0,D0        ;Indicate negative X octants
  2407. LINE10
  2408.     MOVE.W    D7,D2        ;Calculate delta Y
  2409.     SUB.W    D5,D2
  2410.     BPL.S    LINE20        ;Branch if positive
  2411.     NEG.W    D2        ;Make it positive
  2412.     BSET    #1,D0        ;Indicate negative Y octants
  2413. LINE20
  2414.     CMP.W    D1,D2        ;Is delta Y <= delta X
  2415.     BLS.S    LINE30        ;Branch if so
  2416.     EXG    D1,D2        ;Exchange X and Y, so Y is smaller
  2417.     BSET    #2,D0        ;Indicate reversed octants
  2418. LINE30
  2419.     MOVE.B    LINETBL-@-2(PC,D0.W),D0 ;Get octant control code
  2420.     MOVE.W    D0,D7        ;Save it in D7 (high byte must also
  2421.     BRA.S    LINE35        ; be clear)
  2422.  
  2423. ;Table to convert our octant code to Amiga's octant command.
  2424. ; Also sets LINE mode and SIGN flag.
  2425. LINETBL    DC.B    $51        ;0
  2426.     DC.B    $55        ;1
  2427.     DC.B    $59        ;2
  2428.     DC.B    $5D        ;3
  2429.     DC.B    $41        ;4
  2430.     DC.B    $49        ;5
  2431.     DC.B    $45        ;6
  2432.     DC.B    $4D        ;7
  2433. LINE35
  2434.     MOVE.W    D2,D6        ;2Y - X
  2435.     ADD.W    D6,D6
  2436.     SUB.W    D1,D6        ;Save result in D6 for BLTAPTL
  2437.  
  2438.     MOVE.W    D2,D0        ;4Y
  2439.     ASL.W    #2,D0
  2440.     MOVE.W    D0,BLTBMOD(A0)
  2441.  
  2442.     MOVE.W    D2,D0        ;4Y - 4X = (Y - X) *4
  2443.     SUB.W    D1,D0
  2444.     ASL.W    #2,D0
  2445.     MOVE.W    D0,BLTAMOD(A0)
  2446.  
  2447.     ADDQ.W    #1,D1        ;Adjust length to include end point
  2448.     LSL.W    #6,D1        ;Get line length (X) for the height
  2449.     ADD.W    #2,D1        ;Set width to 2, save in D1 for BLTSIZE
  2450.  
  2451.     MOVE.W    WIDTH+2,D0    ;Set no. of bytes per horizontal line
  2452.     LSR.W    #3,D0
  2453.     MOVE.W    D0,BLTCMOD(A0)
  2454.     MOVE.W    D0,BLTDMOD(A0)
  2455.  
  2456.     MOVE.W    TEXTURE,D0    ;Set texture mask
  2457.     NOT.W    D0        ;(A zero gives a solid line)
  2458.     MOVE.W    D0,BLTBDAT(A0)
  2459.  
  2460.     MULU    WIDTH+2,D5    ;Calculate address at start of line
  2461.     EXT.L    D4        ;ADDR = (X0 + Y0 *WIDTH) /8 + RASTER
  2462.     ADD.L    D4,D5
  2463.     ASR.L    #3,D5
  2464.     ADD.L    RASTER,D5
  2465.  
  2466.     MOVE.W    D4,D3        ;Get the bit shift count: REM(X0 /16)
  2467.     SWAP    D3        ; and put it into bits 12-15 of D3
  2468.     MOVE.W    #$B000,D3    ;Set up for BLTCON0 (line draw)
  2469.     LSR.L    #4,D3
  2470.  
  2471.     MOVE.W    WIDTH+2,D4    ;D4 = size = WIDTH *HEIGHT
  2472.     MULU    HEIGHT+2,D4
  2473.     LSR.L    #3,D4        ;Divide by 8 to get size in bytes
  2474.  
  2475.     MOVEQ    #0,D2        ;Depth counter, point to first bit plane
  2476. LINE40    BTST    #0,MODES    ;Is it complement mode?
  2477.     BEQ.S    LINE50        ;Branch if not
  2478.     MOVE.B    #$4A,D3        ;Set complement mode
  2479.     BRA.S    LINE60
  2480. LINE50
  2481.     BTST    D2,COLOR+3    ;Is the bit to be set in this bit plane?
  2482.     BEQ.S    LINE55        ;Branch if not
  2483.     MOVE.B    #$EA,D3        ;Set normal mode
  2484.     BRA.S    LINE60
  2485. LINE55
  2486.     BTST    #1,MODES    ;Is this fast mode?
  2487.     BNE.S    LINE80        ;Branch if so (assume zeros are drawn)
  2488.     MOVE.B    #$2A,D3        ;Erase mode (draw zeros)
  2489. LINE60
  2490.     BSR    WAITBLT        ;Wait for blitter not busy
  2491.     MOVE.W    D3,BLTCON0(A0)    ;Set line draw mode (line function)
  2492.     MOVE.W    D7,BLTCON1(A0)
  2493.     MOVE.W    #$8000,BLTADAT(A0)    ;Set dot mask
  2494.     MOVE.W    D6,BLTAPTL(A0)    ;2Y - X
  2495.     MOVE.L    D5,BLTCPTH(A0)    ;Point to address at the beginning
  2496.     MOVE.L    D5,BLTDPTH(A0)    ; of the line
  2497.     MOVE.W    D1,BLTSIZE(A0)    ;Start the blitter
  2498.  
  2499. LINE80    ADD.L    D4,D5        ;Next bit plane -- add size to addr
  2500.  
  2501.     ADDQ.W    #1,D2        ;(DBF will not work)
  2502.     CMP.W    DEPTH+2,D2
  2503.     BLT.S    LINE40
  2504.  
  2505. LINE90    MOVEM.L    (SP)+,D0-D7/A0    ;Restore registers
  2506.     RTS
  2507.  
  2508. ;----------------------------------------------------------------------
  2509. ;Routine to wait until the blitter is not busy.
  2510. ; Inputs A0 = CHIPREG
  2511. ; Destroys D0
  2512. ;
  2513. WAITBLT    MOVE.W    DMACONR(A0),D0    ;Wait for blitter not busy
  2514.     BTST    #14,D0        ;(Don't change the blitter's registers
  2515.     BNE.S    WAITBLT        ; while it's doing something)
  2516.     RTS
  2517.  
  2518.  
  2519.     IF    @ > MEMTOP - $3000 -$200
  2520.     ERROR -- TOO BIG
  2521.     ENDIF
  2522.     END
  2523. sters